lib/NDWeb/Controller/Members.pm

   1 package NDWeb::Controller::Members;
   2
   3 use strict;
   4 use warnings;
   5 use feature ":5.10";
   6 use parent 'Catalyst::Controller';
   7
   8 use NDWeb::Include;
   9
  10 =head1 NAME
  11
  12 NDWeb::Controller::Members - Catalyst Controller
  13
  14 =head1 DESCRIPTION
  15
  16 Catalyst Controller.
  17
  18 =head1 METHODS
  19
  20 =cut
  21
  22
  23 =head2 index
  24
  25 =cut
  26
  27 sub index : Path : Args(0) {
  28         my ( $self, $c, $order ) = @_;
  29         my $dbh = $c->model;
  30
  31         $c->stash(error => $c->flash->{error});
  32
  33         $c->stash(u => $dbh->selectrow_hashref(q{SELECT pid AS planet,defense_points
  34                         ,attack_points,scan_points,humor_points
  35                         , (attack_points+defense_points+scan_points/20)::NUMERIC(5,1) as total_points
  36                         , sms,rank,hostmask,call_if_needed,sms_note,defprio
  37                 FROM users_defprio WHERE uid = ?
  38                         },undef,$c->user->id)
  39         );
  40
  41         $c->stash(groups => $dbh->selectrow_array(q{SELECT array_agg(groupname)
  42                 FROM groups g NATURAL JOIN groupmembers gm
  43                 WHERE uid = $1
  44                         },undef,$c->user->id)
  45         );
  46
  47         $c->stash(p => $dbh->selectrow_hashref(q{SELECT pid AS id,x,y,z, ruler, planet,race,
  48                 size, size_gain, size_gain_day,
  49                 score,score_gain,score_gain_day,
  50                 value,value_gain,value_gain_day,
  51                 xp,xp_gain,xp_gain_day,
  52                 sizerank,sizerank_gain,sizerank_gain_day,
  53                 scorerank,scorerank_gain,scorerank_gain_day,
  54                 valuerank,valuerank_gain,valuerank_gain_day,
  55                 xprank,xprank_gain,xprank_gain_day
  56                 from current_planet_stats_full p
  57                         WHERE pid = ?
  58                         },undef,$c->user->planet)
  59         );
  60
  61         my $calls = $dbh->prepare(q{
  62 SELECT * FROM defcalls
  63 WHERE uid = $1 AND landing_tick >= tick()
  64 ORDER BY landing_tick DESC
  65                 });
  66         $calls->execute($c->user->id);
  67         $c->stash(calls => $calls->fetchall_arrayref({}) );
  68
  69         $c->stash(fleets => member_fleets($dbh, $c->user->id,$c->user->planet));
  70
  71         my $announcements = $dbh->prepare(q{SELECT ft.ftid, u.username,ft.subject,
  72                 count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts,
  73                 date_trunc('seconds',max(fp.time)::timestamp) as last_post,
  74                 min(fp.time)::date as posting_date, ft.sticky
  75                 FROM forum_threads ft JOIN forum_posts fp USING (ftid)
  76                         JOIN users u ON u.uid = ft.uid
  77                         LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $1) ftv ON ftv.ftid = ft.ftid
  78                 WHERE ft.fbid = 1
  79                 GROUP BY ft.ftid, ft.subject,ft.sticky,u.username
  80                 HAVING count(NULLIF(COALESCE(ft.sticky OR fp.time > ftv.time,TRUE),FALSE)) >= 1
  81                 ORDER BY sticky DESC,last_post DESC
  82                 });
  83         $announcements->execute($c->user->id);
  84         $c->stash(announcements => $announcements->fetchall_arrayref({}) );
  85
  86         my ($attackgroups) = $dbh->selectrow_array(q{
  87 SELECT array_agg(gid) FROM groupmembers WHERE gid IN ('x','y','z') AND uid = $1
  88                 }, undef, $c->user->id);
  89         $c->stash(attackgroups => $attackgroups);
  90
  91 }
  92
  93 sub posthostupdate : Local {
  94         my ( $self, $c ) = @_;
  95         my $dbh = $c->model;
  96
  97         $dbh->do(q{UPDATE users SET hostmask = ? WHERE uid = ?
  98                 },undef, html_escape $c->req->param('hostname'), $c->user->id);
  99
 100         $c->res->redirect($c->uri_for(''));
 101 }
 102
 103 sub postattackgroups : Local {
 104         my ( $self, $c ) = @_;
 105         my $dbh = $c->model;
 106
 107         my @groups = $c->req->param('class');
 108         $dbh->do(q{DELETE FROM groupmembers WHERE gid IN ('x','y','z') AND gid <> ALL($1) AND uid = $2
 109                 },undef, \@groups, $c->user->id);
 110
 111         $dbh->do(q{INSERT INTO groupmembers (uid,gid) (
 112                 SELECT $2, gid FROM unnest($1::text[]) AS gid WHERE gid IN ('x','y','z')
 113         EXCEPT
 114                 SELECT uid,gid FROM groupmembers WHERE uid = $2
 115                 )},undef, \@groups, $c->user->id);
 116
 117         $c->res->redirect($c->uri_for(''));
 118 }
 119
 120 sub postsmsupdate : Local {
 121         my ( $self, $c ) = @_;
 122         my $dbh = $c->model;
 123
 124         my $callme = $c->req->param('callme') || 0;
 125         $dbh->do(q{
 126 UPDATE users SET sms = $1, call_if_needed =  $2, sms_note = $3 WHERE uid = $4
 127                 },undef, html_escape $c->req->param('sms'),$callme
 128                 ,$c->req->param('smsnote'), $c->user->id);
 129
 130         $c->res->redirect($c->uri_for(''));
 131 }
 132
 133 sub postowncoords : Local {
 134         my ( $self, $c ) = @_;
 135         my $dbh = $c->model;
 136
 137         if ($c->user->planet){
 138                 $c->flash(error => 'You already have a planet set.'
 139                         .' Contact a HC if they need to be changed');
 140         }elsif ($c->req->param('planet') =~ m/(\d+)\D+(\d+)\D+(\d+)/){
 141                 my $planet = $dbh->selectrow_array(q{SELECT planetid($1,$2,$3,TICK())
 142                         },undef,$1,$2,$3);
 143
 144                 if ($planet){
 145                         $dbh->do(q{UPDATE users SET planet = ? WHERE uid = ?
 146                                 },undef, $planet , $c->user->id);
 147                 }else{
 148                         $c->flash(error => "No planet at coords: $1:$2:$3");
 149                 }
 150         }else{
 151                 $c->flash(error => $c->req->param('planet') . " are not valid coords.");
 152         }
 153
 154         $c->res->redirect($c->uri_for(''));
 155 }
 156
 157 sub postfleetupdate : Local {
 158         my ( $self, $c ) = @_;
 159         my $dbh = $c->model;
 160
 161         my $fleet = $c->req->param('fleet');
 162         $fleet =~ s/,//g;
 163         my $amount = 0;
 164         my @ships;
 165         while ($fleet =~ m/((?:[A-Z][a-z]+ )*[A-Z][a-z]+)\s+(\d+)/g){
 166                 $amount += $2;
 167                 push @ships, [$1,$2];
 168         }
 169         if ($amount){
 170                 $dbh->begin_work;
 171                 eval{
 172                         my $insert = $dbh->prepare(q{INSERT INTO fleets
 173                                 (pid,name,mission,tick,amount)
 174                                 VALUES (?,'Main','Full fleet',tick(),?) RETURNING fid});
 175                         my ($id) = $dbh->selectrow_array($insert,undef
 176                                 ,$c->user->planet,$amount);
 177                         $insert = $dbh->prepare(q{INSERT INTO fleet_ships
 178                                 (fid,ship,amount) VALUES (?,?,?)});
 179                         for my $s (@ships){
 180                                 unshift @{$s},$id;
 181                                 $insert->execute(@{$s});
 182                         }
 183                         $insert = $dbh->prepare(q{INSERT INTO full_fleets
 184                                 (fid,uid) VALUES (?,?)});
 185                         $insert->execute($id,$c->user->id);
 186                         $dbh->commit;
 187                 };
 188                 if ($@){
 189                         if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 190                                 $c->flash( error => "'$1' is NOT a valid ship");
 191                         }else{
 192                                 $c->flash( error => $@);
 193                         }
 194                         $dbh->rollback;
 195                 }
 196         }else{
 197                 $c->flash( error => 'Fleet does not contain any ships');
 198         }
 199
 200         $c->res->redirect($c->uri_for(''));
 201 }
 202
 203 sub postfleetsupdates : Local {
 204         my ( $self, $c ) = @_;
 205         my $dbh = $c->model;
 206
 207         my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 208                 (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 209                 });
 210         $dbh->begin_work;
 211         if ($c->req->param('cmd') eq 'Recall Fleets'){
 212                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 213                         SET back = tick() + (tick() - (landing_tick - eta))
 214                         WHERE uid = ? AND fid = ? AND back >= tick()+eta
 215                 });
 216
 217                 for my $param ($c->req->param()){
 218                         if ($param =~ /^change:(\d+)$/){
 219                                 $updatefleets->execute($c->user->id,$1);
 220                                 $log->execute($c->user->id,"Member recalled fleet $1");
 221                         }
 222                 }
 223         }elsif ($c->req->param('cmd') eq 'Change Fleets'){
 224                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 225                         SET back = ? WHERE uid = ? AND fid = ?});
 226
 227                 for my $param ($c->req->param()){
 228                         if ($param =~ /^change:(\d+)$/){
 229                                 my $back = $c->req->param("back:$1");
 230                                 $updatefleets->execute($back,$c->user->id,$1);
 231                                 $log->execute($c->user->id,"Member set fleet $1 to be back tick: $back");
 232                         }
 233                 }
 234         }
 235         $dbh->commit;
 236
 237         $c->res->redirect($c->uri_for(''));
 238 }
 239
 240 sub ircrequest : Local {
 241         my ( $self, $c ) = @_;
 242         my $dbh = $c->model;
 243
 244         $c->stash(reply => $c->flash->{reply});
 245         $c->stash(channels => ['scan','members','def']);
 246 }
 247
 248 sub postircrequest : Local {
 249         my ( $self, $c ) = @_;
 250         my $dbh = $c->model;
 251
 252         if ($c->req->param('channel')){
 253                 my $query = $dbh->prepare(q{
 254 INSERT INTO irc_requests (uid,channel,message) VALUES($1,$2,$3)
 255                 });
 256                 $query->execute($c->user->id,$c->req->param('channel'),$c->req->param('message'));
 257                 system 'killall','-USR1', 'irssi';
 258
 259                 $c->flash(reply => "Msg sent to: ".$c->req->param('channel'));
 260                 $c->res->redirect($c->uri_for('ircrequest'));
 261         }else{
 262                 $c->stash(ircmessage => $c->req->param('message'));
 263                 $c->go('ircrequest');
 264         }
 265 }
 266
 267 sub points : Local {
 268         my ( $self, $c, $order ) = @_;
 269         my $dbh = $c->model;
 270
 271         if ($order ~~ /^((?:defense|attack|total|humor|scan|raid)_points)$/
 272                         || $order ~~ /^(defprio)$/){
 273                 $order = "$1 DESC";
 274         }else{
 275                 $order = 'total_points DESC';
 276         }
 277
 278         my $limit = 'LIMIT 10';
 279         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 280
 281         my $query = $dbh->prepare(q{
 282 SELECT username,defense_points,attack_points
 283         ,scan_points,humor_points,defprio
 284         ,(attack_points+defense_points+scan_points/20)::NUMERIC(4,0) as total_points
 285         , count(NULLIF(rc.launched,FALSE)) AS raid_points
 286 FROM users_defprio u LEFT OUTER JOIN raid_claims rc USING (uid)
 287 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 288 GROUP BY username,defense_points,attack_points,scan_points,humor_points,defprio
 289 ORDER BY } . "$order $limit"
 290         );
 291         $query->execute;
 292         $c->stash(members => $query->fetchall_arrayref({}));
 293 }
 294
 295 sub stats : Local {
 296         my ( $self, $c, $order ) = @_;
 297         my $dbh = $c->model;
 298
 299         if ($order ~~ /^(scre|value|xp|size|race)$/){
 300                 $order = "$1rank";
 301         }else{
 302                 $order = 'scorerank';
 303         }
 304         $order .= ',race' if $order eq 'racerank';
 305
 306         my $limit = 'LIMIT 10';
 307         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 308
 309         my ($races) = $dbh->selectrow_array(q{SELECT enum_range(null::race)::text[]});
 310         $c->stash(races => $races);
 311         my $query = $dbh->prepare(q{
 312 SELECT nick
 313         ,rank() OVER(ORDER BY score DESC) AS scorerank
 314         ,rank() OVER(ORDER BY value DESC) AS valuerank
 315         ,rank() OVER(ORDER BY xp DESC) AS xprank
 316         ,rank() OVER(ORDER BY size DESC) AS sizerank
 317         ,rank() OVER(PARTITION BY race ORDER BY score DESC) AS racerank
 318         ,race
 319 FROM current_planet_stats
 320 WHERE alliance = 'NewDawn'
 321         AND race = ANY($1)
 322 ORDER BY } . "$order $limit");
 323         my @race = $c->req->param('race');
 324         my %race = map { $_ => 1 } @race;
 325         $c->stash(race => \%race);
 326         unless (@race){
 327                 @race = @$races;
 328         }
 329         $query->execute(\@race);
 330         $c->stash(members => $query->fetchall_arrayref({}));
 331 }
 332
 333 sub addintel : Local {
 334         my ( $self, $c, $order ) = @_;
 335
 336         $c->stash(intel => $c->flash->{intel});
 337         $c->stash(scans => $c->flash->{scans});
 338         $c->stash(intelmessage => $c->flash->{intelmessage});
 339 }
 340
 341 sub postintel : Local {
 342         my ( $self, $c, $order ) = @_;
 343
 344         $c->forward('insertintel');
 345
 346         $c->res->redirect($c->uri_for('addintel'));
 347 }
 348
 349 sub postintelmessage : Local {
 350         my ( $self, $c, $order ) = @_;
 351
 352         unless ($c->req->param('subject')){
 353                 if ($c->req->param('message') =~ /(.*\w.*)/){
 354                         $c->req->param(subject => $1);
 355                 }
 356         }
 357
 358         $c->forward('/forum/insertThread',[12]);
 359         $c->forward('/forum/insertPost',[$c->stash->{thread}]);
 360         $c->flash(intelmessage => 1);
 361
 362         $c->forward('insertintel');
 363
 364         $c->res->redirect($c->uri_for('addintel'));
 365 }
 366
 367 sub insertintel : Private {
 368         my ( $self, $c, $order ) = @_;
 369         my $dbh = $c->model;
 370
 371         $dbh->begin_work;
 372         my $findscan = $dbh->prepare(q{SELECT scan_id FROM scans
 373                 WHERE scan_id = LOWER(?) AND tick >= tick() - 168 AND groupscan = ?
 374                 });
 375         my $addscan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid,groupscan)
 376                 VALUES (LOWER(?),tick(),?,?)
 377                 });
 378         my $addpoint = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + 1
 379                 WHERE uid = ?
 380                 });
 381         my @scans;
 382         my $intel = $c->req->param('message');
 383         while ($intel =~ m{http://[\w.]+/.+?scan(_id|_grp)?=(\w+)}g){
 384                 my $groupscan = (defined $1 && $1 eq '_grp') || 0;
 385                 my %scan;
 386                 $scan{id} = $2;
 387                 $scan{group} = $groupscan;
 388                 $findscan->execute($2,$groupscan);
 389                 if ($findscan->rows == 0){
 390                         if ($addscan->execute($2,$c->user->id,$groupscan)){
 391                                 $addpoint->execute($c->user->id) unless $groupscan;
 392                                 $scan{added} = 1;
 393                         }
 394                 }else{
 395                         $scan{message} = 'already exists';
 396                 }
 397                 push @scans,\%scan;
 398         }
 399         my $tick = $c->req->param('tick');
 400         unless ($tick =~ /^(\d+)$/){
 401                 $tick = $c->stash->{game}->{tick};
 402         }
 403         my $addintel = $dbh->prepare(q{INSERT INTO intel
 404                 (name,mission,tick,target,sender,eta,amount,ingal,back,uid)
 405                 VALUES($1,$2,$3,planetid($4,$5,$6,$10),planetid($7,$8,$9,$10)
 406                         ,$11,$12,$13,$14,$15)
 407         });
 408         my @intel;
 409         while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)
 410                 \*?\s+(.+)(?:Ter|Cat|Xan|Zik|Etd)?
 411                 \s+(\d+)\s+(Attack|Defend)\s+(\d+)/gx){
 412                 my $ingal = ($1 == $4 && $2 == $5) || 0;
 413                 my $lt = $tick + $10;
 414                 my $back = ($ingal ? $lt + 4 : undef);
 415                 eval {
 416                         $addintel->execute($7,$9,$lt,$1,$2,$3,$4,$5,$6,$tick,$10,$8
 417                                 ,$ingal,$back, $c->user->id);
 418                         push @intel,"Added $&";
 419                 };
 420                 if ($@){
 421                         push @intel,"Couldn't add $&: ".$dbh->errstr;
 422                 }
 423         }
 424         $dbh->commit;
 425         $c->flash(intel => \@intel);
 426         $c->flash(scans => \@scans);
 427 }
 428
 429 sub launchConfirmation : Local {
 430         my ( $self, $c ) = @_;
 431
 432         $c->stash(error => $c->flash->{error});
 433         $c->stash(missions => $c->flash->{missions});
 434 }
 435
 436 sub postconfirmation : Local {
 437         my ( $self, $c ) = @_;
 438         my $dbh = $c->model;
 439
 440         eval {
 441                 my $missions = $c->req->param('mission');
 442                 my $findplanet = $dbh->prepare("SELECT planetid(?,?,?,?)");
 443                 my $findattacktarget = $dbh->prepare(q{SELECT c.target,c.wave,c.launched
 444                         FROM  raid_claims c
 445                                 JOIN raid_targets t ON c.target = t.id
 446                                 JOIN raids r ON t.raid = r.id
 447                         WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
 448                                 AND r.open AND not r.removed
 449                         });
 450                 my $finddefensetarget = $dbh->prepare(q{SELECT call FROM calls c
 451                                 JOIN users u USING (uid)
 452                         WHERE u.pid = $1 AND c.landing_tick = $2
 453                 });
 454                 my $informDefChannel = $dbh->prepare(q{INSERT INTO defense_missions
 455                         (fleet,call) VALUES (?,?)
 456                         });
 457                 my $addattackpoint = $dbh->prepare(q{UPDATE users SET
 458                         attack_points = attack_points + 1 WHERE uid = ?
 459                         });
 460                 my $launchedtarget = $dbh->prepare(q{UPDATE raid_claims SET launched = True
 461                         WHERE uid = ? AND target = ? AND wave = ?
 462                         });
 463                 my $addfleet = $dbh->prepare(q{INSERT INTO fleets
 464                         (name,mission,pid,tick,amount)
 465                         VALUES ($2,$3,(SELECT pid FROM users WHERE uid = $1),tick(),$4)
 466                         RETURNING fid
 467                         });
 468                 my $addconfirmation = $dbh->prepare(q{INSERT INTO launch_confirmations
 469                         (fid,uid,pid,landing_tick,eta,back) VALUES ($1,$2,$3,$4,$5,$6)
 470                         });
 471                 my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (fid,ship,amount)
 472                         VALUES (?,?,?)
 473                         });
 474                 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 475                         (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 476                         });
 477                 my @missions;
 478                 $dbh->begin_work;
 479                 while ($missions && $missions =~ m/([^\n]+)\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)
 480                         \s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+
 481                         (Attack|Defend|Return|Fake\ Attack|Fake\ Defend)
 482                         (.*?)
 483                         (?:Launching\ in\ tick\ (\d+),\ arrival\ in\ tick\ (\d+)
 484                                 |ETA:\ \d+,\ Return\ ETA:\ (\d+)
 485                                 |Return\ ETA:\ (\d+)
 486                                 )/sgx){
 487                         next if $10 eq 'Return';
 488                         my %mission;
 489                         my $name = $1;
 490                         my $tick = $c->stash->{TICK}+$9;
 491                         $tick += $8 if defined $8;
 492                         $tick = $13 if defined $13;
 493                         my $eta = $9;
 494                         $eta += $14 if defined $14;
 495                         my $mission = $10;
 496                         my $x = $5;
 497                         my $y = $6;
 498                         my $z = $7;
 499                         my $back = $tick + $eta - 1;
 500                         $mission{tick} = $tick;
 501                         $mission{mission} = $mission;
 502                         $mission{target} = "$x:$y:$z";
 503                         $mission{back} = $back;
 504
 505                         my ($planet_id) = $dbh->selectrow_array($findplanet,undef,$x,$y,$z,$c->stash->{TICK});
 506
 507                         my $findtarget = $finddefensetarget;
 508                         if ($mission eq 'Attack'){
 509                                 $findtarget = $findattacktarget;
 510                                 $findtarget->execute($c->user->id,$tick,$planet_id);
 511                         }elsif ($mission eq 'Defend'){
 512                                 $findtarget = $finddefensetarget;
 513                                 $findtarget->execute($planet_id,$tick);
 514                         }
 515
 516                         my $ships = $11;
 517                         my @ships;
 518                         my $amount = 0;
 519                         while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+(?:(?:\w+|-)\s+){3}(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Structure Killer)\s+(\d+)/g){
 520                                 $amount += $2;
 521                                 push @ships,{ship => $1, amount => $2};
 522                         }
 523                         $mission{ships} = \@ships;
 524
 525                         if ($amount == 0){
 526                                 warn "No ships in: $ships";
 527                                 next;
 528                         }
 529                         my $fleet = $dbh->selectrow_array($addfleet,undef,$c->user->id,$name
 530                                 ,$mission,$amount);
 531                         $addconfirmation->execute($fleet,$c->user->id,$planet_id,$tick,$eta,$back);
 532                         $mission{fleet} = $fleet;
 533                         for my $ship (@ships){
 534                                 $addships->execute($fleet,$ship->{ship},$ship->{amount});
 535                         }
 536
 537                         if ($findtarget->rows == 0){
 538                                 $mission{warning} = 'No matching target!';
 539                         }elsif ($mission eq 'Attack'){
 540                                 my $claim = $findtarget->fetchrow_hashref;
 541                                 if ($claim->{launched}){
 542                                         $mission{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
 543                                 }else{
 544                                         $addattackpoint->execute($c->user->id);
 545                                         $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
 546                                         $mission{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
 547                                         $log->execute($c->user->id,"Gave attack point for confirmation on $mission mission to $x:$y:$z, landing tick $tick");
 548                                 }
 549                         }elsif ($mission eq 'Defend'){
 550                                 my $call = $findtarget->fetchrow_hashref;
 551                                 $informDefChannel->execute($fleet,$call->{call});
 552                         }
 553
 554                         $log->execute($c->user->id,"Pasted confirmation for $mission mission to $x:$y:$z, landing tick $tick");
 555                         push @missions,\%mission;
 556                 }
 557                 $dbh->commit;
 558                 $c->flash(missions => \@missions);
 559         };
 560         if ($@){
 561                 $dbh->rollback;
 562                 if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 563                         $c->flash( error => "'$1' is NOT a valid ship");
 564                 }else{
 565                         $c->flash( error => $@);
 566                 }
 567         }
 568
 569         $c->res->redirect($c->uri_for('launchConfirmation'));
 570 }
 571
 572 sub defenders : Local {
 573         my ( $self, $c, $order ) = @_;
 574         my $dbh = $c->model;
 575
 576         my $defenders = $dbh->prepare(q{
 577 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
 578         ,sms_note, call_if_needed, race, timezone
 579 FROM users u
 580         JOIN current_planet_stats p USING (pid)
 581 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 582 ORDER BY call_if_needed DESC, username
 583                 });
 584         $defenders->execute;
 585
 586         my $available = $dbh->prepare(q{
 587 SELECT ship,amount FROM available_ships WHERE pid = $1
 588                 });
 589
 590         my @members;
 591         while (my $member = $defenders->fetchrow_hashref){
 592
 593                 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
 594                 $available->execute($member->{planet});
 595                 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
 596                         , ships => $available->fetchall_arrayref({})
 597                 };
 598                 push @{$member->{fleets}}, $fleet;
 599                 push @members,$member;
 600         }
 601         $c->stash(members => \@members);
 602 }
 603
 604 sub member_fleets {
 605         my ( $dbh, $uid, $planet ) = @_;
 606
 607         my $query = $dbh->prepare(q{
 608 (
 609         SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
 610                 ,amount, NULL AS coords, pid AS target, NULL AS back
 611                 ,NULL AS recalled, mission
 612         FROM fleets f
 613         WHERE pid = $2 AND tick <= tick() AND tick >= tick() -  24
 614                 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
 615         ORDER BY mission,name,tick DESC, fid DESC
 616 ) UNION (
 617         SELECT fid,name,landing_tick AS tick, eta, amount
 618                 , coords(x,y,z), lc.pid AS target, back
 619                 , (back <> landing_tick + eta - 1) AS recalled
 620                 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
 621                         THEN 'Returning' ELSE mission END AS mission
 622         FROM  launch_confirmations lc
 623                 LEFT OUTER JOIN current_planet_stats t USING (pid)
 624                 JOIN fleets f USING (fid)
 625         WHERE uid = $1 AND f.pid = $2 AND back > tick()
 626                 AND landing_tick - eta - 12 < tick()
 627 )
 628                 });
 629
 630         my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
 631                 WHERE fid = ? ORDER BY num
 632                 });
 633
 634         $query->execute($uid,$planet);
 635         my @fleets;
 636         while (my $fleet = $query->fetchrow_hashref){
 637                 my @ships;
 638                 $ships->execute($fleet->{fid});
 639                 while (my $ship = $ships->fetchrow_hashref){
 640                         push @ships,$ship;
 641                 }
 642                 $fleet->{ships} = \@ships;
 643                 push @fleets,$fleet;
 644         }
 645         return \@fleets;
 646 }
 647
 648 =head1 AUTHOR
 649
 650 Michael Andreen (harv@ruin.nu)
 651
 652 =head1 LICENSE
 653
 654 GPL 2.0, or later.
 655
 656 =cut
 657
 658 1;