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