lib/NDWeb/Controller/Members.pm

   1 package NDWeb::Controller::Members;
   2
   3 use strict;
   4 use warnings;
   5 use feature ":5.10";
   6 use Try::Tiny;
   7 use parent 'Catalyst::Controller';
   8
   9 use NDWeb::Include;
  10
  11 =head1 NAME
  12
  13 NDWeb::Controller::Members - Catalyst Controller
  14
  15 =head1 DESCRIPTION
  16
  17 Catalyst Controller.
  18
  19 =head1 METHODS
  20
  21 =cut
  22
  23
  24 =head2 index
  25
  26 =cut
  27
  28 sub index : Path : Args(0) {
  29         my ( $self, $c, $order ) = @_;
  30         my $dbh = $c->model;
  31
  32         $c->stash(error => $c->flash->{error});
  33
  34         $c->stash(u => $dbh->selectrow_hashref(q{SELECT pid AS planet,defense_points
  35                         ,attack_points,scan_points,humor_points
  36                         , (attack_points+defense_points+scan_points/20)::NUMERIC(5,1) as total_points
  37                         , sms,rank,hostmask,call_if_needed,sms_note,defprio
  38                 FROM users_defprio WHERE uid = ?
  39                         },undef,$c->user->id)
  40         );
  41
  42         $c->stash(groups => $dbh->selectrow_array(q{SELECT array_agg(groupname)
  43                 FROM groups g NATURAL JOIN groupmembers gm
  44                 WHERE uid = $1
  45                         },undef,$c->user->id)
  46         );
  47
  48         $c->stash(p => $dbh->selectrow_hashref(q{SELECT pid AS id,x,y,z, ruler, planet,race,
  49                 size, size_gain, size_gain_day,
  50                 score,score_gain,score_gain_day,
  51                 value,value_gain,value_gain_day,
  52                 xp,xp_gain,xp_gain_day,
  53                 sizerank,sizerank_gain,sizerank_gain_day,
  54                 scorerank,scorerank_gain,scorerank_gain_day,
  55                 valuerank,valuerank_gain,valuerank_gain_day,
  56                 xprank,xprank_gain,xprank_gain_day
  57                 from current_planet_stats_full p
  58                         WHERE pid = ?
  59                         },undef,$c->user->planet)
  60         );
  61
  62         my $calls = $dbh->prepare(q{
  63 SELECT * FROM defcalls
  64 WHERE uid = $1 AND landing_tick >= tick()
  65 ORDER BY landing_tick DESC
  66                 });
  67         $calls->execute($c->user->id);
  68         $c->stash(calls => $calls->fetchall_arrayref({}) );
  69
  70         $c->stash(fleets => member_fleets($dbh, $c->user->id,$c->user->planet));
  71
  72         my $announcements = $dbh->prepare(q{SELECT ft.ftid, u.username,ft.subject,
  73                 count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts,
  74                 date_trunc('seconds',max(fp.time)::timestamp) as last_post,
  75                 min(fp.time)::date as posting_date, ft.sticky
  76                 FROM forum_threads ft JOIN forum_posts fp USING (ftid)
  77                         JOIN users u ON u.uid = ft.uid
  78                         LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $1) ftv ON ftv.ftid = ft.ftid
  79                 WHERE ft.fbid = 1
  80                 GROUP BY ft.ftid, ft.subject,ft.sticky,u.username
  81                 HAVING count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) >= 1
  82                 ORDER BY sticky DESC,last_post DESC
  83                 });
  84         $announcements->execute($c->user->id);
  85         $c->stash(announcements => $announcements->fetchall_arrayref({}) );
  86
  87         my ($attackgroups) = $dbh->selectrow_array(q{
  88 SELECT array_agg(gid) FROM groupmembers WHERE gid IN ('x','y','z') AND uid = $1
  89                 }, undef, $c->user->id);
  90         $c->stash(attackgroups => $attackgroups);
  91
  92 }
  93
  94 sub posthostupdate : Local {
  95         my ( $self, $c ) = @_;
  96         my $dbh = $c->model;
  97
  98         my $hostname = html_escape $c->req->param('hostname');
  99         $dbh->do(q{UPDATE users SET hostmask = ? WHERE uid = ?
 100                 },undef, $hostname, $c->user->id);
 101
 102         $c->res->redirect($c->uri_for(''));
 103 }
 104
 105 sub postattackgroups : Local {
 106         my ( $self, $c ) = @_;
 107         my $dbh = $c->model;
 108
 109         my @groups = $c->req->param('class');
 110         $dbh->do(q{DELETE FROM groupmembers WHERE gid IN ('x','y','z') AND gid <> ALL($1) AND uid = $2
 111                 },undef, \@groups, $c->user->id);
 112
 113         $dbh->do(q{INSERT INTO groupmembers (uid,gid) (
 114                 SELECT $2, gid FROM unnest($1::text[]) AS gid WHERE gid IN ('x','y','z')
 115         EXCEPT
 116                 SELECT uid,gid FROM groupmembers WHERE uid = $2
 117                 )},undef, \@groups, $c->user->id);
 118
 119         $c->res->redirect($c->uri_for(''));
 120 }
 121
 122 sub postsmsupdate : Local {
 123         my ( $self, $c ) = @_;
 124         my $dbh = $c->model;
 125
 126         my $callme = $c->req->param('callme') || 0;
 127         my $sms = html_escape $c->req->param('sms');
 128         my $smsnote = $c->req->param('smsnote');
 129         $dbh->do(q{
 130 UPDATE users SET sms = $1, call_if_needed =  $2, sms_note = $3 WHERE uid = $4
 131                 },undef, $sms, $callme, $smsnote, $c->user->id);
 132
 133         $c->res->redirect($c->uri_for(''));
 134 }
 135
 136 sub postowncoords : Local {
 137         my ( $self, $c ) = @_;
 138         my $dbh = $c->model;
 139
 140         if ($c->user->planet){
 141                 $c->flash(error => 'You already have a planet set.'
 142                         .' Contact a HC if they need to be changed');
 143         }elsif (my ($x,$y,$z) = $c->req->param('planet') =~ m/(\d+)\D+(\d+)\D+(\d+)/){
 144                 my $planet = $dbh->selectrow_array(q{SELECT planetid($1,$2,$3,TICK())
 145                         },undef,$x,$y,$z);
 146
 147                 if ($planet){
 148                         eval {
 149                                 $dbh->do(q{UPDATE users SET pid = ? WHERE uid = ?
 150                                         },undef, $planet , $c->user->id);
 151                         };
 152                         given ($@){
 153                                 when (''){}
 154                                 when (/duplicate key value violates/){
 155                                         $c->flash(error => "The coords $x:$y:$z are already in use. Talk to hc if these are really your coords.")
 156                                 }
 157                                 default {
 158                                         $c->flash(error => $@)
 159                                 }
 160                         }
 161                 }else{
 162                         $c->flash(error => "No planet at coords: $x:$y:$z");
 163                 }
 164         }else{
 165                 my $error = $c->req->param('planet') . " are not valid coords.";
 166                 $c->flash(error => $error);
 167         }
 168
 169         $c->res->redirect($c->uri_for('/'.$c->session->{referrer}));
 170 }
 171
 172 sub postfleetsupdates : Local {
 173         my ( $self, $c ) = @_;
 174         my $dbh = $c->model;
 175
 176         my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 177                 (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 178                 });
 179         $dbh->begin_work;
 180         if ($c->req->param('cmd') eq 'Recall Fleets'){
 181                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 182                         SET back = tick() + (tick() - (landing_tick - eta))
 183                         WHERE uid = ? AND fid = ? AND back >= tick()+eta
 184                 });
 185
 186                 for my $param ($c->req->param()){
 187                         if ($param =~ /^change:(\d+)$/){
 188                                 $updatefleets->execute($c->user->id,$1);
 189                                 $log->execute($c->user->id,"Member recalled fleet $1");
 190                         }
 191                 }
 192         }elsif ($c->req->param('cmd') eq 'Change Fleets'){
 193                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 194                         SET back = ? WHERE uid = ? AND fid = ?});
 195
 196                 for my $param ($c->req->param()){
 197                         if ($param =~ /^change:(\d+)$/){
 198                                 my $back = $c->req->param("back:$1");
 199                                 $updatefleets->execute($back,$c->user->id,$1);
 200                                 $log->execute($c->user->id,"Member set fleet $1 to be back tick: $back");
 201                         }
 202                 }
 203         }
 204         $dbh->commit;
 205
 206         $c->res->redirect($c->uri_for(''));
 207 }
 208
 209 sub ircrequest : Local {
 210         my ( $self, $c ) = @_;
 211         my $dbh = $c->model;
 212
 213         $c->stash(reply => $c->flash->{reply});
 214         $c->stash(channels => ['scan','members','def']);
 215 }
 216
 217 sub postircrequest : Local {
 218         my ( $self, $c ) = @_;
 219         my $dbh = $c->model;
 220
 221         my $message = $c->req->param('message');
 222         if ($c->req->param('channel')){
 223                 my $query = $dbh->prepare(q{
 224 INSERT INTO irc_requests (uid,channel,message) VALUES($1,$2,$3)
 225                 });
 226                 my $channel = $c->user->id,$c->req->param('channel');
 227                 $query->execute($channel, $message);
 228                 $c->signal_bots;
 229
 230                 $c->flash(reply => "Msg sent to: ".$channel);
 231                 $c->res->redirect($c->uri_for('ircrequest'));
 232         }else{
 233                 $c->stash(ircmessage => $message);
 234                 $c->go('ircrequest');
 235         }
 236 }
 237
 238 sub points : Local {
 239         my ( $self, $c, $order ) = @_;
 240         my $dbh = $c->model;
 241
 242         $order //= 'total_points';
 243         if ($order ~~ /^((?:defense|attack|total|humor|scan|raid)_points)$/
 244                         || $order ~~ /^(defprio)$/){
 245                 $order = "$1 DESC";
 246         }else{
 247                 $order = 'total_points DESC';
 248         }
 249
 250         my $limit = 'LIMIT 10';
 251         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 252
 253         my $query = $dbh->prepare(q{
 254 SELECT username,defense_points,attack_points
 255         ,scan_points,humor_points,defprio
 256         ,(attack_points+defense_points+scan_points/20)::NUMERIC(4,0) as total_points
 257         , count(NULLIF(rc.launched,FALSE)) AS raid_points
 258 FROM users_defprio u LEFT OUTER JOIN raid_claims rc USING (uid)
 259 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 260 GROUP BY username,defense_points,attack_points,scan_points,humor_points,defprio
 261 ORDER BY } . "$order $limit"
 262         );
 263         $query->execute;
 264         $c->stash(members => $query->fetchall_arrayref({}));
 265 }
 266
 267 sub stats : Local {
 268         my ( $self, $c, $order ) = @_;
 269         my $dbh = $c->model;
 270
 271         $order //= 'score';
 272         if ($order ~~ /^(scre|value|xp|size|race)$/){
 273                 $order = "$1rank";
 274         }else{
 275                 $order = 'scorerank';
 276         }
 277         $order .= ',race' if $order eq 'racerank';
 278
 279         my $limit = 'LIMIT 10';
 280         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 281
 282         my ($races) = $dbh->selectrow_array(q{SELECT enum_range(null::race)::text[]});
 283         $c->stash(races => $races);
 284         my $query = $dbh->prepare(q{
 285 SELECT nick
 286         ,rank() OVER(ORDER BY score DESC) AS scorerank
 287         ,rank() OVER(ORDER BY value DESC) AS valuerank
 288         ,rank() OVER(ORDER BY xp DESC) AS xprank
 289         ,rank() OVER(ORDER BY size DESC) AS sizerank
 290         ,rank() OVER(PARTITION BY race ORDER BY score DESC) AS racerank
 291         ,race
 292 FROM current_planet_stats
 293 WHERE alliance = 'NewDawn'
 294         AND race = ANY($1)
 295 ORDER BY } . "$order $limit");
 296         my @race = $c->req->param('race');
 297         my %race = map { $_ => 1 } @race;
 298         $c->stash(race => \%race);
 299         unless (@race){
 300                 @race = @$races;
 301         }
 302         $query->execute(\@race);
 303         $c->stash(members => $query->fetchall_arrayref({}));
 304 }
 305
 306 sub addintel : Local {
 307         my ( $self, $c, $order ) = @_;
 308
 309         $c->stash(intel => $c->flash->{intel});
 310         $c->stash(scans => $c->flash->{scans});
 311         $c->stash(intelmessage => $c->flash->{intelmessage});
 312 }
 313
 314 sub postintel : Local {
 315         my ( $self, $c, $order ) = @_;
 316
 317         $c->forward('insertintel');
 318
 319         $c->res->redirect($c->uri_for('addintel'));
 320 }
 321
 322 sub postintelmessage : Local {
 323         my ( $self, $c, $order ) = @_;
 324
 325         unless ($c->req->param('subject')){
 326                 if ($c->req->param('message') =~ /(.*\w.*)/){
 327                         $c->req->param(subject => $1);
 328                 }
 329         }
 330
 331         my ($coords,$tick) = $c->model->selectrow_array(q{
 332 SELECT coords(x,y,z), tick() FROM current_planet_stats WHERE pid = $1
 333                 }, undef, $c->user->planet);
 334
 335         my $message = "[i]Posted by $coords at tick $tick [/i]\n\n" . $c->req->param('message');
 336         $c->req->param(message => $message);
 337         $c->forward('/forum/insertThread',[12]);
 338         $c->forward('/forum/insertPost',[$c->stash->{thread}]);
 339         $c->flash(intelmessage => 1);
 340
 341         $c->forward('insertintel');
 342
 343         $c->res->redirect($c->uri_for('addintel'));
 344 }
 345
 346 sub insertintel : Private {
 347         my ( $self, $c, $order ) = @_;
 348         my $dbh = $c->model;
 349
 350         $dbh->begin_work;
 351         my $findscan = $dbh->prepare(q{SELECT scan_id FROM scans
 352                 WHERE scan_id = LOWER(?) AND tick >= tick() - 168 AND groupscan = ?
 353                 });
 354         my $addscan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid,groupscan)
 355                 VALUES (LOWER(?),tick(),?,?)
 356                 });
 357         my $addpoint = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + 1
 358                 WHERE uid = ?
 359                 });
 360         my @scans;
 361         my $intel = $c->req->param('message');
 362         while ($intel =~ m{https?://[\w.]+/.+?scan(_id|_grp)?=(\w+)}g){
 363                 my $groupscan = (defined $1 && $1 eq '_grp') || 0;
 364                 my %scan;
 365                 $scan{id} = $2;
 366                 $scan{group} = $groupscan;
 367                 $findscan->execute($2,$groupscan);
 368                 if ($findscan->rows == 0){
 369                         if ($addscan->execute($2,$c->user->id,$groupscan)){
 370                                 $addpoint->execute($c->user->id) unless $groupscan;
 371                                 $scan{added} = 1;
 372                         }
 373                 }else{
 374                         $scan{message} = 'already exists';
 375                 }
 376                 push @scans,\%scan;
 377         }
 378         my $tick = $c->req->param('tick');
 379         unless ($tick =~ /^(\d+)$/){
 380                 $tick = $c->stash->{game}->{tick};
 381         }
 382         my $addintel = $dbh->prepare(q{INSERT INTO intel
 383                 (name,mission,tick,target,sender,eta,amount,ingal,back,uid)
 384                 VALUES($1,$2,$3,planetid($4,$5,$6,$10),planetid($7,$8,$9,$10)
 385                         ,$11,$12,$13,$14,$15)
 386         });
 387         my @intel;
 388         while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)
 389                 \*?\s+(A|D)\s+(.+?)\s+(?:(?:Ter|Cat|Xan|Zik|Etd)\s+)?(\d+)\s+(\d+)/gx){
 390                 my $ingal = ($1 == $4 && $2 == $5) || 0;
 391                 my $lt = $tick + $10;
 392                 my $back = ($ingal ? $lt + 4 : undef);
 393                 my $mission = $7 eq 'A' ? 'Attack' : 'Defend';
 394                 eval {
 395                         $addintel->execute($8,$mission,$lt,$1,$2,$3,$4,$5,$6,$tick,$10,$9
 396                                 ,$ingal,$back, $c->user->id);
 397                         push @intel,"Added $&";
 398                 };
 399                 if ($@){
 400                         push @intel,"Couldn't add $&: ".$dbh->errstr;
 401                 }
 402         }
 403         $dbh->commit;
 404         $c->flash(intel => \@intel);
 405         $c->flash(scans => \@scans);
 406 }
 407
 408 sub addincs : Local {
 409         my ( $self, $c ) = @_;
 410         $c->stash(incs => $c->flash->{incs});
 411
 412 }
 413
 414 sub postincs : Local {
 415         my ( $self, $c ) = @_;
 416         my $dbh = $c->model;
 417
 418         my @incs;
 419
 420         my $user = $dbh->prepare(q{
 421 SELECT uid FROM users u
 422 WHERE pid = planetid($1,$2,$3,tick())
 423         AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 424                 });
 425         my $call = $dbh->prepare(q{
 426 SELECT call
 427 FROM calls WHERE uid = $1 AND landing_tick = tick() + $2
 428                 });
 429         my $fleet = $dbh->prepare(q{
 430 SELECT pid
 431 FROM incomings i
 432 WHERE pid = planetid($1,$2,$3,tick()) AND amount = $4 and fleet = $5 AND call = $6
 433                 });
 434         my $irc = $dbh->prepare(q{
 435 INSERT INTO irc_requests (uid,channel,message) VALUES($1,'def',$2)
 436                 });
 437
 438         my $msg = $c->req->param('message');
 439         while ($msg =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\*?\s+A\s+(.+?)\s+(Ter|Cat|Xan|Zik|Etd)\s+(\d+)\s+(\d+)/gc
 440                         ||$msg =~ /expand\s+(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+(\d+)/gc
 441                         || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/gc){
 442
 443                 my $inc = {message => $&};
 444                 my $amount = $9;
 445                 {
 446                         $amount =~ s/,//g;
 447                 }
 448                 try {
 449                         my $uid = $dbh->selectrow_array($user,undef,$1,$2,$3);
 450                         die '<i>No user with these coords</i>' unless $uid;
 451
 452                         my $call = $dbh->selectrow_array($call,undef,$uid,$10);
 453                         if ($call){
 454                                 my $pid = $dbh->selectrow_hashref($fleet,undef,$4,$5,$6,$amount,$7,$call);
 455                                 die '<i>Duplicate</i>' if $pid;
 456
 457                         }
 458
 459                         my $message = "$1:$2:$3 $4:$5:$6 $7 $8 $amount $10";
 460                         $irc->execute($c->user->id, $message);
 461                         $inc->{status} = '<b>Added</b>';
 462
 463                 } catch {
 464                         when (m(^(<i>.*</i>) at )){
 465                                 $inc->{status} = $1;
 466                         }
 467                         default {
 468                                 $inc->{status} = $_;
 469                         }
 470                 };
 471                 push @incs, $inc;
 472         }
 473
 474         $c->signal_bots if @incs;
 475         $c->flash(incs => \@incs);
 476         $c->res->redirect($c->uri_for('addincs'));
 477 }
 478
 479 sub launchConfirmation : Local {
 480         my ( $self, $c ) = @_;
 481
 482         $c->stash(error => $c->flash->{error});
 483         $c->stash(missions => $c->flash->{missions});
 484 }
 485
 486 sub postconfirmation : Local {
 487         my ( $self, $c ) = @_;
 488         my $dbh = $c->model;
 489
 490         try {
 491                 my $findplanet = $dbh->prepare(q{SELECT planetid(?,?,?,tick())});
 492                 my $addfleet = $dbh->prepare(q{INSERT INTO fleets
 493                         (name,mission,pid,tick,amount)
 494                         VALUES ($2,$3,(SELECT pid FROM users WHERE uid = $1),tick(),$4)
 495                         RETURNING fid
 496                         });
 497                 my $updatefleet = $dbh->prepare(q{
 498 UPDATE launch_confirmations SET back = $2 WHERE fid = $1
 499                         });
 500                 my $addconfirmation = $dbh->prepare(q{INSERT INTO launch_confirmations
 501                         (fid,uid,pid,landing_tick,eta,back,num) VALUES ($1,$2,$3,$4,$5,$6,$7)
 502                         });
 503                 my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (fid,ship,amount)
 504                         VALUES (?,?,?)
 505                         });
 506                 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 507                         (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 508                         });
 509                 my $return = $dbh->prepare(q{
 510 UPDATE launch_confirmations SET back = tick()
 511 WHERE uid = $1 AND num = $2 AND back > tick()
 512                         });
 513                 my $fullfleet = $dbh->prepare(q{INSERT INTO full_fleets
 514                                         (fid,uid) VALUES (?,?)});
 515                 $dbh->begin_work;
 516                 my $mission = $c->req->param('mission');
 517                 my @missions = parseconfirmations($mission, $c->stash->{TICK});
 518                 for my $m (@missions){
 519                         if ($m->{mission} eq 'Return'){
 520                                 $c->forward("addReturnFleet", [$m]);
 521                                 if($m->{fid}){
 522                                         $updatefleet->execute($m->{fid},$m->{back});
 523                                         next;
 524                                 }else{
 525                                         $m->{pid} = $c->user->planet;
 526                                 }
 527                         }elsif ($m->{target} ~~ /^(\d+):(\d+):(\d+)$/) {
 528                                 $m->{pid} = $dbh->selectrow_array($findplanet,undef,$1,$2,$3);
 529                                 unless ($m->{pid}){
 530                                         $m->{warning} = "No planet at $m->{target}, try again next tick.";
 531                                         next;
 532                                 }
 533                         }
 534
 535                         #Recall fleets with same slot number
 536                         $return->execute($c->user->id,$m->{num});
 537
 538                         unless ($m->{mission}){
 539                                 $m->{warning} = "Not on a mission, but matching fleets recalled";
 540                                 next;
 541                         }
 542
 543                         $c->forward("findDuplicateFleet", [$m]);
 544                         if ($m->{match}){
 545                                 $m->{warning} = "Already confirmed this fleet, updating changed information";
 546                                 $updatefleet->execute($m->{fid},$m->{back}) if $m->{pid};
 547                                 next;
 548                         }
 549
 550
 551                         $m->{fleet} = $dbh->selectrow_array($addfleet,undef,$c->user->id,$m->{name}
 552                                 ,$m->{mission},$m->{amount});
 553
 554                         if ($m->{mission} eq 'Full fleet'){
 555                                 $fullfleet->execute($m->{fleet},$c->user->id);
 556                         }else{
 557                                 $addconfirmation->execute($m->{fleet},$c->user->id,$m->{pid},$m->{tick},$m->{eta},$m->{back},$m->{num});
 558                         }
 559
 560                         if ($m->{mission} eq 'Attack'){
 561                                 $c->forward("addAttackFleet", [$m]);
 562                         }elsif ($m->{mission} eq 'Defend'){
 563                                 $c->forward("addDefendFleet", [$m]);
 564                         }
 565
 566                         for my $ship (@{$m->{ships}}){
 567                                 $addships->execute($m->{fleet},$ship->{ship},$ship->{amount});
 568                         }
 569                         $log->execute($c->user->id,"Pasted confirmation for $m->{mission} mission to $m->{target}, landing tick $m->{tick}");
 570                 }
 571                 $c->flash(missions => \@missions);
 572                 $dbh->commit;
 573                 $c->signal_bots;
 574         } catch {
 575                 $dbh->rollback;
 576                 when (/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 577                         $c->flash( error => "'$1' is NOT a valid ship");
 578                 }
 579                 default{
 580                         $c->flash( error => $_);
 581                 }
 582         };
 583         $c->res->redirect($c->uri_for('launchConfirmation'));
 584 }
 585
 586 sub parseconfirmations {
 587         my ( $missions, $tick ) = @_;
 588         return unless $missions;
 589         my @slots;
 590         $missions =~ s/\s?,\s?//g;
 591         $missions =~ s/\s*([:+])\s*/$1/g;
 592         $missions =~ s/\(\s/(/g;
 593         $missions =~ s/\s\)/)/g;
 594         my $returnetare = qr/(\d+) \s+
 595                 Arrival:\s*(\d+)/sx;
 596         my $missionetare = qr/\s* (\d+ \+ \s*)? (\d+) \s+
 597                 Arrival:\s*(\d+) \s+
 598                 \QReturn ETA:\E\s*(?:(?<eta>Instant) \s+ Cancel \s+ Order
 599                         | (?<eta>\d+) \s+ Ticks \s+ Recall \s+ Fleet)/sx;
 600         my $etare = qr/(Galaxy:\d+Universe:\d+(?:Alliance:\d+)?
 601                 |$missionetare
 602                 |$returnetare)\s*/x;
 603         my $missre = qr/((?:Alliance\ Standby)|(?:(?:Fake\ )?\w+))\s*/x;
 604         if ($missions =~ m/
 605                 Ships \s+ Cla \s+ T\s?1 \s+ T\s?2 \s+ T\s?3 \s+ ETA \s+ Base \s+ \(i\) \s (?<name>.+?) \s+ \(i\) \s+ (?<name>.+?) \s+ \(i\) \s+ (?<name>.+?) \s+ \(i\) \s+ TOTAL \s+
 606                 (?<ships>.+?)
 607                 \QTotal Ships in Fleet\E \s+ (\d+) \s+ (?<amount>\d+) \s+ (?<amount>\d+) \s+ (?<amount>\d+) \s+
 608                 Mission: \s* (?<missions>(?:$missre)*)  \s*
 609                 Target: \s* (?<targets>((\d+:\d+:\d+)?\s)*) \s*
 610                 \QLaunch Tick:\E \s* (?<lts>(\d+\s+)*) \s*
 611                 ETA: \s* (?<etas>(?:$etare)*)
 612                 /sx){
 613                 my %match = %-;
 614                 my @targets = split /\s+/, $+{targets};
 615                 my @lts = split /\s+/, $+{lts};
 616                 my @etas;
 617                 local $_ = $+{etas};
 618                 while(/$etare/sxg){
 619                         push @etas, $1;
 620                 }
 621                 my @missions ;
 622                 $_ = $+{missions};
 623                 while(/$missre/sxg){
 624                         push @missions, $1;
 625                 }
 626                 for my $i (0..2){
 627                         my %mission = (
 628                                 name => $match{name}->[$i],
 629                                 mission => '' ,
 630                                 amount => $match{amount}->[$i],
 631                                 num => $i,
 632                                 ships => []
 633                         );
 634                         if ($mission{amount} == 0){
 635                                 push @slots,\%mission;
 636                                 next;
 637                         }
 638
 639                         if ($missions[0] eq 'Alliance Standby'){
 640                                 shift @missions;
 641                                 push @slots,\%mission;
 642                                 next;
 643                         }
 644
 645                         given(shift @etas){
 646                                 when(/$missionetare/sx){
 647                                         $mission{tick} = $3;
 648                                         $mission{eta} = $2 + $+{eta};
 649                                         $mission{back} = $3 + $mission{eta} - 1;
 650                                         $mission{target} = shift @targets;
 651                                         $mission{lt} = shift @lts;
 652                                         $mission{mission} = shift @missions;
 653                                 }
 654                                 when(/$returnetare/sx){
 655                                         $mission{tick} = $2;
 656                                         $mission{eta} = $1;
 657                                         $mission{back} = $2;
 658                                         $mission{target} = shift @targets;
 659                                         $mission{lt} = shift @lts;
 660                                         $mission{mission} = shift @missions;
 661                                         die "Did you forget some at the end? '$mission{mission}'" if $mission{mission} ne 'Return';
 662                                 }
 663                         }
 664                         push @slots,\%mission;
 665                 }
 666                 push @slots,{
 667                         name => 'Main',
 668                         num => 3,
 669                         mission => 'Full fleet',
 670                         tick => $tick,
 671                         amount => 0,
 672                         ships => []
 673                 };
 674                 while ($match{ships}->[0] =~ m/(\w[ \w]+?)\s+(FI|CO|FR|DE|CR|BS|--)[^\d]+\d+\s+((?:\d+\s*){5})/g){
 675                         my $ship = $1;
 676                         my @amounts = split /\D+/, $3;
 677                         my $base = shift @amounts;
 678                         die "Ships don't sum up properly" if $amounts[3] != $base + $amounts[0] + $amounts[1] + $amounts[2];
 679                         for my $i (0..3){
 680                                 push @{$slots[$i]->{ships}},{ship => $ship, amount => $amounts[$i]} if $amounts[$i] > 0;
 681                         }
 682                         $slots[3]->{amount} += $amounts[3];
 683                 }
 684         }
 685         return @slots;
 686 }
 687
 688 sub findDuplicateFleet : Private {
 689         my ( $self, $c, $m ) = @_;
 690         my $dbh = $c->model;
 691
 692         my $findfleet = $dbh->prepare(q{
 693 SELECT fid FROM fleets f
 694         LEFT JOIN launch_confirmations lc USING (fid)
 695 WHERE f.pid = (SELECT pid FROM users WHERE uid = $1)
 696         AND mission = $3 AND amount = $4 AND (mission <> 'Full fleet' OR tick > $6 - 6)
 697         AND COALESCE(uid = $1 AND num = $2 AND lc.pid = $5 AND landing_tick = $6, TRUE)
 698                 });
 699         my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{num}
 700                 ,$m->{mission},$m->{amount}, $m->{pid}, $m->{tick});
 701         $c->forward("matchShips", [$m,$fid]);
 702         $m->{fid} = $fid if $m->{match};
 703 }
 704
 705 sub addAttackFleet : Private {
 706         my ( $self, $c, $m ) = @_;
 707         my $dbh = $c->model;
 708
 709         my $findattacktarget = $dbh->prepare(q{
 710 SELECT c.target,c.wave,c.launched
 711 FROM  raid_claims c
 712         JOIN raid_targets t ON c.target = t.id
 713         JOIN raids r ON t.raid = r.id
 714 WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
 715         AND r.open AND not r.removed
 716                 });
 717         my $launchedtarget = $dbh->prepare(q{
 718 UPDATE raid_claims SET launched = TRUE
 719 WHERE uid = ? AND target = ? AND wave = ?
 720                 });
 721         my $claim = $dbh->selectrow_hashref($findattacktarget,undef,$c->user->id,$m->{tick},$m->{pid});
 722         if ($claim->{launched}){
 723                 $m->{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
 724         }elsif(defined $claim->{launched}){
 725                 $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
 726                 $m->{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
 727         }else{
 728                 $m->{warning} = "You haven't claimed this target";
 729         }
 730 }
 731
 732 sub addDefendFleet : Private {
 733         my ( $self, $c, $m ) = @_;
 734         my $dbh = $c->model;
 735
 736         my $finddefensetarget = $dbh->prepare(q{
 737 SELECT call FROM calls c
 738         JOIN users u USING (uid)
 739 WHERE u.pid = $1 AND c.landing_tick = $2
 740         });
 741         my $informDefChannel = $dbh->prepare(q{
 742 INSERT INTO defense_missions (fleet,call) VALUES (?,?)
 743                 });
 744         my $call = $dbh->selectrow_hashref($finddefensetarget,undef,$m->{pid},$m->{tick});
 745         if ($call->{call}){
 746                 $informDefChannel->execute($m->{fleet},$call->{call});
 747         }else{
 748                 $m->{warning} = "No call for $m->{target} landing tick $m->{tick}";
 749         }
 750 }
 751
 752 sub addReturnFleet : Private {
 753         my ( $self, $c, $m ) = @_;
 754         my $dbh = $c->model;
 755
 756         my $findfleet = $dbh->prepare(q{
 757 SELECT fid FROM fleets f
 758         JOIN launch_confirmations lc USING (fid)
 759 WHERE uid = $1 AND num = $2  AND amount = $3
 760         AND back >= $4
 761                 });
 762         my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{num}
 763                 ,$m->{amount}, $m->{tick});
 764         $c->forward("matchShips", [$m,$fid]);
 765         if ($m->{match}){
 766                 $m->{fid} = $fid;
 767                 $m->{warning} = "Return fleet, changed back tick to match the return eta.";
 768         } else {
 769                 $m->{warning} = "Couldn't find a fleet matching this returning fleet, so adding a new fleet that is returning";
 770         }
 771 }
 772
 773 sub matchShips : Private {
 774         my ( $self, $c, $m, $fid ) = @_;
 775         return unless $fid;
 776         my $dbh = $c->model;
 777
 778         my $ships = $dbh->prepare(q{
 779 SELECT ship, amount FROM fleet_ships WHERE fid = $1 ORDER BY num
 780                 });
 781         $ships->execute($fid);
 782         for my $s (@{$m->{ships}}){
 783                 my $s2 = $ships->fetchrow_hashref;
 784                 return unless $s->{ship} eq $s2->{ship} && $s->{amount} == $s2->{amount};
 785         }
 786         $m->{match} = 1;
 787
 788 }
 789
 790 sub defenders : Local {
 791         my ( $self, $c, $order ) = @_;
 792         my $dbh = $c->model;
 793
 794         my $defenders = $dbh->prepare(q{
 795 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
 796         ,sms_note, call_if_needed, race, timezone
 797 FROM users u
 798         JOIN current_planet_stats p USING (pid)
 799 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 800 ORDER BY call_if_needed DESC, username
 801                 });
 802         $defenders->execute;
 803
 804         my $available = $dbh->prepare(q{
 805 SELECT ship,amount FROM available_ships WHERE pid = $1
 806                 });
 807
 808         my @members;
 809         while (my $member = $defenders->fetchrow_hashref){
 810
 811                 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
 812                 $available->execute($member->{planet});
 813                 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
 814                         , ships => $available->fetchall_arrayref({})
 815                 };
 816                 push @{$member->{fleets}}, $fleet;
 817                 push @members,$member;
 818         }
 819         $c->stash(members => \@members);
 820 }
 821
 822 sub member_fleets {
 823         my ( $dbh, $uid, $planet ) = @_;
 824
 825         my $query = $dbh->prepare(q{
 826 (
 827         SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
 828                 ,amount, NULL AS coords, pid AS target, NULL AS back
 829                 ,NULL AS recalled, mission
 830         FROM fleets f
 831         WHERE pid = $2 AND tick <= tick() AND tick >= tick() -  24
 832                 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
 833         ORDER BY mission,name,tick DESC, fid DESC
 834 ) UNION (
 835         SELECT fid,name,landing_tick AS tick, eta, amount
 836                 , coords(x,y,z), lc.pid AS target, back
 837                 , (back <> landing_tick + eta - 1) AS recalled
 838                 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
 839                         THEN 'Returning' ELSE mission END AS mission
 840         FROM  launch_confirmations lc
 841                 LEFT OUTER JOIN current_planet_stats t USING (pid)
 842                 JOIN fleets f USING (fid)
 843         WHERE uid = $1 AND f.pid = $2 AND back > tick()
 844                 AND landing_tick - eta - 12 < tick()
 845 )
 846                 });
 847
 848         my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
 849                 WHERE fid = ? ORDER BY num
 850                 });
 851
 852         $query->execute($uid,$planet);
 853         my @fleets;
 854         while (my $fleet = $query->fetchrow_hashref){
 855                 my @ships;
 856                 $ships->execute($fleet->{fid});
 857                 while (my $ship = $ships->fetchrow_hashref){
 858                         push @ships,$ship;
 859                 }
 860                 $fleet->{ships} = \@ships;
 861                 push @fleets,$fleet;
 862         }
 863         return \@fleets;
 864 }
 865
 866 =head1 AUTHOR
 867
 868 Michael Andreen (harv@ruin.nu)
 869
 870 =head1 LICENSE
 871
 872 GPL 2.0, or later.
 873
 874 =cut
 875
 876 1;