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 (my ($x,$y,$z) = $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,$x,$y,$z);
 143
 144                 if ($planet){
 145                         eval {
 146                                 $dbh->do(q{UPDATE users SET pid = ? WHERE uid = ?
 147                                         },undef, $planet , $c->user->id);
 148                         };
 149                         given ($@){
 150                                 when (''){}
 151                                 when (/duplicate key value violates/){
 152                                         $c->flash(error => "The coords $x:$y:$z are already in use. Talk to hc if these are really your coords.")
 153                                 }
 154                                 default {
 155                                         $c->flash(error => $@)
 156                                 }
 157                         }
 158                 }else{
 159                         $c->flash(error => "No planet at coords: $x:$y:$z");
 160                 }
 161         }else{
 162                 $c->flash(error => $c->req->param('planet') . " are not valid coords.");
 163         }
 164
 165         $c->res->redirect($c->uri_for(''));
 166 }
 167
 168 sub postfleetupdate : Local {
 169         my ( $self, $c ) = @_;
 170         my $dbh = $c->model;
 171
 172         my $fleet = $c->req->param('fleet');
 173         $fleet =~ s/,//g;
 174         my $amount = 0;
 175         my @ships;
 176         while ($fleet =~ m/((?:[A-Z][a-z]+ )*[A-Z][a-z]+)\s+(\d+)/g){
 177                 $amount += $2;
 178                 push @ships, [$1,$2];
 179         }
 180         if ($amount){
 181                 $dbh->begin_work;
 182                 eval{
 183                         my $insert = $dbh->prepare(q{INSERT INTO fleets
 184                                 (pid,name,mission,tick,amount)
 185                                 VALUES (?,'Main','Full fleet',tick(),?) RETURNING fid});
 186                         my ($id) = $dbh->selectrow_array($insert,undef
 187                                 ,$c->user->planet,$amount);
 188                         $insert = $dbh->prepare(q{INSERT INTO fleet_ships
 189                                 (fid,ship,amount) VALUES (?,?,?)});
 190                         for my $s (@ships){
 191                                 unshift @{$s},$id;
 192                                 $insert->execute(@{$s});
 193                         }
 194                         $insert = $dbh->prepare(q{INSERT INTO full_fleets
 195                                 (fid,uid) VALUES (?,?)});
 196                         $insert->execute($id,$c->user->id);
 197                         $dbh->commit;
 198                 };
 199                 if ($@){
 200                         if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 201                                 $c->flash( error => "'$1' is NOT a valid ship");
 202                         }else{
 203                                 $c->flash( error => $@);
 204                         }
 205                         $dbh->rollback;
 206                 }
 207         }else{
 208                 $c->flash( error => 'Fleet does not contain any ships');
 209         }
 210
 211         $c->res->redirect($c->uri_for(''));
 212 }
 213
 214 sub postfleetsupdates : Local {
 215         my ( $self, $c ) = @_;
 216         my $dbh = $c->model;
 217
 218         my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 219                 (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 220                 });
 221         $dbh->begin_work;
 222         if ($c->req->param('cmd') eq 'Recall Fleets'){
 223                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 224                         SET back = tick() + (tick() - (landing_tick - eta))
 225                         WHERE uid = ? AND fid = ? AND back >= tick()+eta
 226                 });
 227
 228                 for my $param ($c->req->param()){
 229                         if ($param =~ /^change:(\d+)$/){
 230                                 $updatefleets->execute($c->user->id,$1);
 231                                 $log->execute($c->user->id,"Member recalled fleet $1");
 232                         }
 233                 }
 234         }elsif ($c->req->param('cmd') eq 'Change Fleets'){
 235                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 236                         SET back = ? WHERE uid = ? AND fid = ?});
 237
 238                 for my $param ($c->req->param()){
 239                         if ($param =~ /^change:(\d+)$/){
 240                                 my $back = $c->req->param("back:$1");
 241                                 $updatefleets->execute($back,$c->user->id,$1);
 242                                 $log->execute($c->user->id,"Member set fleet $1 to be back tick: $back");
 243                         }
 244                 }
 245         }
 246         $dbh->commit;
 247
 248         $c->res->redirect($c->uri_for(''));
 249 }
 250
 251 sub ircrequest : Local {
 252         my ( $self, $c ) = @_;
 253         my $dbh = $c->model;
 254
 255         $c->stash(reply => $c->flash->{reply});
 256         $c->stash(channels => ['scan','members','def']);
 257 }
 258
 259 sub postircrequest : Local {
 260         my ( $self, $c ) = @_;
 261         my $dbh = $c->model;
 262
 263         if ($c->req->param('channel')){
 264                 my $query = $dbh->prepare(q{
 265 INSERT INTO irc_requests (uid,channel,message) VALUES($1,$2,$3)
 266                 });
 267                 $query->execute($c->user->id,$c->req->param('channel'),$c->req->param('message'));
 268                 system 'killall','-USR1', 'ndbot.pl';
 269
 270                 $c->flash(reply => "Msg sent to: ".$c->req->param('channel'));
 271                 $c->res->redirect($c->uri_for('ircrequest'));
 272         }else{
 273                 $c->stash(ircmessage => $c->req->param('message'));
 274                 $c->go('ircrequest');
 275         }
 276 }
 277
 278 sub points : Local {
 279         my ( $self, $c, $order ) = @_;
 280         my $dbh = $c->model;
 281
 282         if ($order ~~ /^((?:defense|attack|total|humor|scan|raid)_points)$/
 283                         || $order ~~ /^(defprio)$/){
 284                 $order = "$1 DESC";
 285         }else{
 286                 $order = 'total_points DESC';
 287         }
 288
 289         my $limit = 'LIMIT 10';
 290         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 291
 292         my $query = $dbh->prepare(q{
 293 SELECT username,defense_points,attack_points
 294         ,scan_points,humor_points,defprio
 295         ,(attack_points+defense_points+scan_points/20)::NUMERIC(4,0) as total_points
 296         , count(NULLIF(rc.launched,FALSE)) AS raid_points
 297 FROM users_defprio u LEFT OUTER JOIN raid_claims rc USING (uid)
 298 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 299 GROUP BY username,defense_points,attack_points,scan_points,humor_points,defprio
 300 ORDER BY } . "$order $limit"
 301         );
 302         $query->execute;
 303         $c->stash(members => $query->fetchall_arrayref({}));
 304 }
 305
 306 sub stats : Local {
 307         my ( $self, $c, $order ) = @_;
 308         my $dbh = $c->model;
 309
 310         if ($order ~~ /^(scre|value|xp|size|race)$/){
 311                 $order = "$1rank";
 312         }else{
 313                 $order = 'scorerank';
 314         }
 315         $order .= ',race' if $order eq 'racerank';
 316
 317         my $limit = 'LIMIT 10';
 318         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 319
 320         my ($races) = $dbh->selectrow_array(q{SELECT enum_range(null::race)::text[]});
 321         $c->stash(races => $races);
 322         my $query = $dbh->prepare(q{
 323 SELECT nick
 324         ,rank() OVER(ORDER BY score DESC) AS scorerank
 325         ,rank() OVER(ORDER BY value DESC) AS valuerank
 326         ,rank() OVER(ORDER BY xp DESC) AS xprank
 327         ,rank() OVER(ORDER BY size DESC) AS sizerank
 328         ,rank() OVER(PARTITION BY race ORDER BY score DESC) AS racerank
 329         ,race
 330 FROM current_planet_stats
 331 WHERE alliance = 'NewDawn'
 332         AND race = ANY($1)
 333 ORDER BY } . "$order $limit");
 334         my @race = $c->req->param('race');
 335         my %race = map { $_ => 1 } @race;
 336         $c->stash(race => \%race);
 337         unless (@race){
 338                 @race = @$races;
 339         }
 340         $query->execute(\@race);
 341         $c->stash(members => $query->fetchall_arrayref({}));
 342 }
 343
 344 sub addintel : Local {
 345         my ( $self, $c, $order ) = @_;
 346
 347         $c->stash(intel => $c->flash->{intel});
 348         $c->stash(scans => $c->flash->{scans});
 349         $c->stash(intelmessage => $c->flash->{intelmessage});
 350 }
 351
 352 sub postintel : Local {
 353         my ( $self, $c, $order ) = @_;
 354
 355         $c->forward('insertintel');
 356
 357         $c->res->redirect($c->uri_for('addintel'));
 358 }
 359
 360 sub postintelmessage : Local {
 361         my ( $self, $c, $order ) = @_;
 362
 363         unless ($c->req->param('subject')){
 364                 if ($c->req->param('message') =~ /(.*\w.*)/){
 365                         $c->req->param(subject => $1);
 366                 }
 367         }
 368
 369         my ($coords,$tick) = $c->model->selectrow_array(q{
 370 SELECT coords(x,y,z), tick() FROM current_planet_stats WHERE pid = $1
 371                 }, undef, $c->user->planet);
 372
 373         $c->req->param(message => "[i]Posted by $coords at tick $tick [/i]\n\n" . $c->req->param('message'));
 374         $c->forward('/forum/insertThread',[12]);
 375         $c->forward('/forum/insertPost',[$c->stash->{thread}]);
 376         $c->flash(intelmessage => 1);
 377
 378         $c->forward('insertintel');
 379
 380         $c->res->redirect($c->uri_for('addintel'));
 381 }
 382
 383 sub insertintel : Private {
 384         my ( $self, $c, $order ) = @_;
 385         my $dbh = $c->model;
 386
 387         $dbh->begin_work;
 388         my $findscan = $dbh->prepare(q{SELECT scan_id FROM scans
 389                 WHERE scan_id = LOWER(?) AND tick >= tick() - 168 AND groupscan = ?
 390                 });
 391         my $addscan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid,groupscan)
 392                 VALUES (LOWER(?),tick(),?,?)
 393                 });
 394         my $addpoint = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + 1
 395                 WHERE uid = ?
 396                 });
 397         my @scans;
 398         my $intel = $c->req->param('message');
 399         while ($intel =~ m{http://[\w.]+/.+?scan(_id|_grp)?=(\w+)}g){
 400                 my $groupscan = (defined $1 && $1 eq '_grp') || 0;
 401                 my %scan;
 402                 $scan{id} = $2;
 403                 $scan{group} = $groupscan;
 404                 $findscan->execute($2,$groupscan);
 405                 if ($findscan->rows == 0){
 406                         if ($addscan->execute($2,$c->user->id,$groupscan)){
 407                                 $addpoint->execute($c->user->id) unless $groupscan;
 408                                 $scan{added} = 1;
 409                         }
 410                 }else{
 411                         $scan{message} = 'already exists';
 412                 }
 413                 push @scans,\%scan;
 414         }
 415         my $tick = $c->req->param('tick');
 416         unless ($tick =~ /^(\d+)$/){
 417                 $tick = $c->stash->{game}->{tick};
 418         }
 419         my $addintel = $dbh->prepare(q{INSERT INTO intel
 420                 (name,mission,tick,target,sender,eta,amount,ingal,back,uid)
 421                 VALUES($1,$2,$3,planetid($4,$5,$6,$10),planetid($7,$8,$9,$10)
 422                         ,$11,$12,$13,$14,$15)
 423         });
 424         my @intel;
 425         while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)
 426                 \*?\s+(.+)(?:Ter|Cat|Xan|Zik|Etd)?
 427                 \s+(\d+)\s+(Attack|Defend)\s+(\d+)/gx){
 428                 my $ingal = ($1 == $4 && $2 == $5) || 0;
 429                 my $lt = $tick + $10;
 430                 my $back = ($ingal ? $lt + 4 : undef);
 431                 eval {
 432                         $addintel->execute($7,$9,$lt,$1,$2,$3,$4,$5,$6,$tick,$10,$8
 433                                 ,$ingal,$back, $c->user->id);
 434                         push @intel,"Added $&";
 435                 };
 436                 if ($@){
 437                         push @intel,"Couldn't add $&: ".$dbh->errstr;
 438                 }
 439         }
 440         $dbh->commit;
 441         $c->flash(intel => \@intel);
 442         $c->flash(scans => \@scans);
 443 }
 444
 445 sub launchConfirmation : Local {
 446         my ( $self, $c ) = @_;
 447
 448         $c->stash(error => $c->flash->{error});
 449         $c->stash(missions => $c->flash->{missions});
 450 }
 451
 452 sub postconfirmation : Local {
 453         my ( $self, $c ) = @_;
 454         my $dbh = $c->model;
 455
 456         eval {
 457                 my $missions = $c->req->param('mission');
 458                 my $findplanet = $dbh->prepare("SELECT planetid(?,?,?,?)");
 459                 my $findattacktarget = $dbh->prepare(q{SELECT c.target,c.wave,c.launched
 460                         FROM  raid_claims c
 461                                 JOIN raid_targets t ON c.target = t.id
 462                                 JOIN raids r ON t.raid = r.id
 463                         WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
 464                                 AND r.open AND not r.removed
 465                         });
 466                 my $finddefensetarget = $dbh->prepare(q{SELECT call FROM calls c
 467                                 JOIN users u USING (uid)
 468                         WHERE u.pid = $1 AND c.landing_tick = $2
 469                 });
 470                 my $informDefChannel = $dbh->prepare(q{INSERT INTO defense_missions
 471                         (fleet,call) VALUES (?,?)
 472                         });
 473                 my $addattackpoint = $dbh->prepare(q{UPDATE users SET
 474                         attack_points = attack_points + 1 WHERE uid = ?
 475                         });
 476                 my $launchedtarget = $dbh->prepare(q{UPDATE raid_claims SET launched = True
 477                         WHERE uid = ? AND target = ? AND wave = ?
 478                         });
 479                 my $addfleet = $dbh->prepare(q{INSERT INTO fleets
 480                         (name,mission,pid,tick,amount)
 481                         VALUES ($2,$3,(SELECT pid FROM users WHERE uid = $1),tick(),$4)
 482                         RETURNING fid
 483                         });
 484                 my $addconfirmation = $dbh->prepare(q{INSERT INTO launch_confirmations
 485                         (fid,uid,pid,landing_tick,eta,back) VALUES ($1,$2,$3,$4,$5,$6)
 486                         });
 487                 my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (fid,ship,amount)
 488                         VALUES (?,?,?)
 489                         });
 490                 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 491                         (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 492                         });
 493                 my @missions;
 494                 $dbh->begin_work;
 495                 while ($missions && $missions =~ m/([^\n]+)\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)
 496                         \s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+
 497                         (Attack|Defend|Return|Fake\ Attack|Fake\ Defend)
 498                         (.*?)
 499                         (?:Launching\ in\ tick\ (\d+),\ arrival\ in\ tick\ (\d+)
 500                                 |ETA:\ \d+,\ Return\ ETA:\ (\d+)
 501                                 |Return\ ETA:\ (\d+)
 502                                 )/sgx){
 503                         next if $10 eq 'Return';
 504                         my %mission;
 505                         my $name = $1;
 506                         my $tick = $c->stash->{TICK}+$9;
 507                         $tick += $8 if defined $8;
 508                         $tick = $13 if defined $13;
 509                         my $eta = $9;
 510                         $eta += $14 if defined $14;
 511                         my $mission = $10;
 512                         my $x = $5;
 513                         my $y = $6;
 514                         my $z = $7;
 515                         my $back = $tick + $eta - 1;
 516                         $mission{tick} = $tick;
 517                         $mission{mission} = $mission;
 518                         $mission{target} = "$x:$y:$z";
 519                         $mission{back} = $back;
 520
 521                         my ($planet_id) = $dbh->selectrow_array($findplanet,undef,$x,$y,$z,$c->stash->{TICK});
 522
 523                         my $findtarget = $finddefensetarget;
 524                         if ($mission eq 'Attack'){
 525                                 $findtarget = $findattacktarget;
 526                                 $findtarget->execute($c->user->id,$tick,$planet_id);
 527                         }elsif ($mission eq 'Defend'){
 528                                 $findtarget = $finddefensetarget;
 529                                 $findtarget->execute($planet_id,$tick);
 530                         }
 531
 532                         my $ships = $11;
 533                         my @ships;
 534                         my $amount = 0;
 535                         while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+(?:(?:\w+|-)\s+){3}(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Structure Killer)\s+(\d+)/g){
 536                                 $amount += $2;
 537                                 push @ships,{ship => $1, amount => $2};
 538                         }
 539                         $mission{ships} = \@ships;
 540
 541                         if ($amount == 0){
 542                                 warn "No ships in: $ships";
 543                                 next;
 544                         }
 545                         my $fleet = $dbh->selectrow_array($addfleet,undef,$c->user->id,$name
 546                                 ,$mission,$amount);
 547                         $addconfirmation->execute($fleet,$c->user->id,$planet_id,$tick,$eta,$back);
 548                         $mission{fleet} = $fleet;
 549                         for my $ship (@ships){
 550                                 $addships->execute($fleet,$ship->{ship},$ship->{amount});
 551                         }
 552
 553                         if ($findtarget->rows == 0){
 554                                 $mission{warning} = 'No matching target!';
 555                         }elsif ($mission eq 'Attack'){
 556                                 my $claim = $findtarget->fetchrow_hashref;
 557                                 if ($claim->{launched}){
 558                                         $mission{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
 559                                 }else{
 560                                         $addattackpoint->execute($c->user->id);
 561                                         $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
 562                                         $mission{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
 563                                         $log->execute($c->user->id,"Gave attack point for confirmation on $mission mission to $x:$y:$z, landing tick $tick");
 564                                 }
 565                         }elsif ($mission eq 'Defend'){
 566                                 my $call = $findtarget->fetchrow_hashref;
 567                                 $informDefChannel->execute($fleet,$call->{call});
 568                         }
 569
 570                         $log->execute($c->user->id,"Pasted confirmation for $mission mission to $x:$y:$z, landing tick $tick");
 571                         push @missions,\%mission;
 572                 }
 573                 $dbh->commit;
 574                 $c->flash(missions => \@missions);
 575         };
 576         if ($@){
 577                 $dbh->rollback;
 578                 if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 579                         $c->flash( error => "'$1' is NOT a valid ship");
 580                 }else{
 581                         $c->flash( error => $@);
 582                 }
 583         }
 584
 585         $c->res->redirect($c->uri_for('launchConfirmation'));
 586 }
 587
 588 sub defenders : Local {
 589         my ( $self, $c, $order ) = @_;
 590         my $dbh = $c->model;
 591
 592         my $defenders = $dbh->prepare(q{
 593 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
 594         ,sms_note, call_if_needed, race, timezone
 595 FROM users u
 596         JOIN current_planet_stats p USING (pid)
 597 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 598 ORDER BY call_if_needed DESC, username
 599                 });
 600         $defenders->execute;
 601
 602         my $available = $dbh->prepare(q{
 603 SELECT ship,amount FROM available_ships WHERE pid = $1
 604                 });
 605
 606         my @members;
 607         while (my $member = $defenders->fetchrow_hashref){
 608
 609                 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
 610                 $available->execute($member->{planet});
 611                 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
 612                         , ships => $available->fetchall_arrayref({})
 613                 };
 614                 push @{$member->{fleets}}, $fleet;
 615                 push @members,$member;
 616         }
 617         $c->stash(members => \@members);
 618 }
 619
 620 sub member_fleets {
 621         my ( $dbh, $uid, $planet ) = @_;
 622
 623         my $query = $dbh->prepare(q{
 624 (
 625         SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
 626                 ,amount, NULL AS coords, pid AS target, NULL AS back
 627                 ,NULL AS recalled, mission
 628         FROM fleets f
 629         WHERE pid = $2 AND tick <= tick() AND tick >= tick() -  24
 630                 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
 631         ORDER BY mission,name,tick DESC, fid DESC
 632 ) UNION (
 633         SELECT fid,name,landing_tick AS tick, eta, amount
 634                 , coords(x,y,z), lc.pid AS target, back
 635                 , (back <> landing_tick + eta - 1) AS recalled
 636                 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
 637                         THEN 'Returning' ELSE mission END AS mission
 638         FROM  launch_confirmations lc
 639                 LEFT OUTER JOIN current_planet_stats t USING (pid)
 640                 JOIN fleets f USING (fid)
 641         WHERE uid = $1 AND f.pid = $2 AND back > tick()
 642                 AND landing_tick - eta - 12 < tick()
 643 )
 644                 });
 645
 646         my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
 647                 WHERE fid = ? ORDER BY num
 648                 });
 649
 650         $query->execute($uid,$planet);
 651         my @fleets;
 652         while (my $fleet = $query->fetchrow_hashref){
 653                 my @ships;
 654                 $ships->execute($fleet->{fid});
 655                 while (my $ship = $ships->fetchrow_hashref){
 656                         push @ships,$ship;
 657                 }
 658                 $fleet->{ships} = \@ships;
 659                 push @fleets,$fleet;
 660         }
 661         return \@fleets;
 662 }
 663
 664 =head1 AUTHOR
 665
 666 Michael Andreen (harv@ruin.nu)
 667
 668 =head1 LICENSE
 669
 670 GPL 2.0, or later.
 671
 672 =cut
 673
 674 1;