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', 'irssi';
 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         $c->forward('/forum/insertThread',[12]);
 370         $c->forward('/forum/insertPost',[$c->stash->{thread}]);
 371         $c->flash(intelmessage => 1);
 372
 373         $c->forward('insertintel');
 374
 375         $c->res->redirect($c->uri_for('addintel'));
 376 }
 377
 378 sub insertintel : Private {
 379         my ( $self, $c, $order ) = @_;
 380         my $dbh = $c->model;
 381
 382         $dbh->begin_work;
 383         my $findscan = $dbh->prepare(q{SELECT scan_id FROM scans
 384                 WHERE scan_id = LOWER(?) AND tick >= tick() - 168 AND groupscan = ?
 385                 });
 386         my $addscan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid,groupscan)
 387                 VALUES (LOWER(?),tick(),?,?)
 388                 });
 389         my $addpoint = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + 1
 390                 WHERE uid = ?
 391                 });
 392         my @scans;
 393         my $intel = $c->req->param('message');
 394         while ($intel =~ m{http://[\w.]+/.+?scan(_id|_grp)?=(\w+)}g){
 395                 my $groupscan = (defined $1 && $1 eq '_grp') || 0;
 396                 my %scan;
 397                 $scan{id} = $2;
 398                 $scan{group} = $groupscan;
 399                 $findscan->execute($2,$groupscan);
 400                 if ($findscan->rows == 0){
 401                         if ($addscan->execute($2,$c->user->id,$groupscan)){
 402                                 $addpoint->execute($c->user->id) unless $groupscan;
 403                                 $scan{added} = 1;
 404                         }
 405                 }else{
 406                         $scan{message} = 'already exists';
 407                 }
 408                 push @scans,\%scan;
 409         }
 410         my $tick = $c->req->param('tick');
 411         unless ($tick =~ /^(\d+)$/){
 412                 $tick = $c->stash->{game}->{tick};
 413         }
 414         my $addintel = $dbh->prepare(q{INSERT INTO intel
 415                 (name,mission,tick,target,sender,eta,amount,ingal,back,uid)
 416                 VALUES($1,$2,$3,planetid($4,$5,$6,$10),planetid($7,$8,$9,$10)
 417                         ,$11,$12,$13,$14,$15)
 418         });
 419         my @intel;
 420         while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)
 421                 \*?\s+(.+)(?:Ter|Cat|Xan|Zik|Etd)?
 422                 \s+(\d+)\s+(Attack|Defend)\s+(\d+)/gx){
 423                 my $ingal = ($1 == $4 && $2 == $5) || 0;
 424                 my $lt = $tick + $10;
 425                 my $back = ($ingal ? $lt + 4 : undef);
 426                 eval {
 427                         $addintel->execute($7,$9,$lt,$1,$2,$3,$4,$5,$6,$tick,$10,$8
 428                                 ,$ingal,$back, $c->user->id);
 429                         push @intel,"Added $&";
 430                 };
 431                 if ($@){
 432                         push @intel,"Couldn't add $&: ".$dbh->errstr;
 433                 }
 434         }
 435         $dbh->commit;
 436         $c->flash(intel => \@intel);
 437         $c->flash(scans => \@scans);
 438 }
 439
 440 sub launchConfirmation : Local {
 441         my ( $self, $c ) = @_;
 442
 443         $c->stash(error => $c->flash->{error});
 444         $c->stash(missions => $c->flash->{missions});
 445 }
 446
 447 sub postconfirmation : Local {
 448         my ( $self, $c ) = @_;
 449         my $dbh = $c->model;
 450
 451         eval {
 452                 my $missions = $c->req->param('mission');
 453                 my $findplanet = $dbh->prepare("SELECT planetid(?,?,?,?)");
 454                 my $findattacktarget = $dbh->prepare(q{SELECT c.target,c.wave,c.launched
 455                         FROM  raid_claims c
 456                                 JOIN raid_targets t ON c.target = t.id
 457                                 JOIN raids r ON t.raid = r.id
 458                         WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
 459                                 AND r.open AND not r.removed
 460                         });
 461                 my $finddefensetarget = $dbh->prepare(q{SELECT call FROM calls c
 462                                 JOIN users u USING (uid)
 463                         WHERE u.pid = $1 AND c.landing_tick = $2
 464                 });
 465                 my $informDefChannel = $dbh->prepare(q{INSERT INTO defense_missions
 466                         (fleet,call) VALUES (?,?)
 467                         });
 468                 my $addattackpoint = $dbh->prepare(q{UPDATE users SET
 469                         attack_points = attack_points + 1 WHERE uid = ?
 470                         });
 471                 my $launchedtarget = $dbh->prepare(q{UPDATE raid_claims SET launched = True
 472                         WHERE uid = ? AND target = ? AND wave = ?
 473                         });
 474                 my $addfleet = $dbh->prepare(q{INSERT INTO fleets
 475                         (name,mission,pid,tick,amount)
 476                         VALUES ($2,$3,(SELECT pid FROM users WHERE uid = $1),tick(),$4)
 477                         RETURNING fid
 478                         });
 479                 my $addconfirmation = $dbh->prepare(q{INSERT INTO launch_confirmations
 480                         (fid,uid,pid,landing_tick,eta,back) VALUES ($1,$2,$3,$4,$5,$6)
 481                         });
 482                 my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (fid,ship,amount)
 483                         VALUES (?,?,?)
 484                         });
 485                 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 486                         (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 487                         });
 488                 my @missions;
 489                 $dbh->begin_work;
 490                 while ($missions && $missions =~ m/([^\n]+)\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)
 491                         \s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+
 492                         (Attack|Defend|Return|Fake\ Attack|Fake\ Defend)
 493                         (.*?)
 494                         (?:Launching\ in\ tick\ (\d+),\ arrival\ in\ tick\ (\d+)
 495                                 |ETA:\ \d+,\ Return\ ETA:\ (\d+)
 496                                 |Return\ ETA:\ (\d+)
 497                                 )/sgx){
 498                         next if $10 eq 'Return';
 499                         my %mission;
 500                         my $name = $1;
 501                         my $tick = $c->stash->{TICK}+$9;
 502                         $tick += $8 if defined $8;
 503                         $tick = $13 if defined $13;
 504                         my $eta = $9;
 505                         $eta += $14 if defined $14;
 506                         my $mission = $10;
 507                         my $x = $5;
 508                         my $y = $6;
 509                         my $z = $7;
 510                         my $back = $tick + $eta - 1;
 511                         $mission{tick} = $tick;
 512                         $mission{mission} = $mission;
 513                         $mission{target} = "$x:$y:$z";
 514                         $mission{back} = $back;
 515
 516                         my ($planet_id) = $dbh->selectrow_array($findplanet,undef,$x,$y,$z,$c->stash->{TICK});
 517
 518                         my $findtarget = $finddefensetarget;
 519                         if ($mission eq 'Attack'){
 520                                 $findtarget = $findattacktarget;
 521                                 $findtarget->execute($c->user->id,$tick,$planet_id);
 522                         }elsif ($mission eq 'Defend'){
 523                                 $findtarget = $finddefensetarget;
 524                                 $findtarget->execute($planet_id,$tick);
 525                         }
 526
 527                         my $ships = $11;
 528                         my @ships;
 529                         my $amount = 0;
 530                         while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+(?:(?:\w+|-)\s+){3}(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Structure Killer)\s+(\d+)/g){
 531                                 $amount += $2;
 532                                 push @ships,{ship => $1, amount => $2};
 533                         }
 534                         $mission{ships} = \@ships;
 535
 536                         if ($amount == 0){
 537                                 warn "No ships in: $ships";
 538                                 next;
 539                         }
 540                         my $fleet = $dbh->selectrow_array($addfleet,undef,$c->user->id,$name
 541                                 ,$mission,$amount);
 542                         $addconfirmation->execute($fleet,$c->user->id,$planet_id,$tick,$eta,$back);
 543                         $mission{fleet} = $fleet;
 544                         for my $ship (@ships){
 545                                 $addships->execute($fleet,$ship->{ship},$ship->{amount});
 546                         }
 547
 548                         if ($findtarget->rows == 0){
 549                                 $mission{warning} = 'No matching target!';
 550                         }elsif ($mission eq 'Attack'){
 551                                 my $claim = $findtarget->fetchrow_hashref;
 552                                 if ($claim->{launched}){
 553                                         $mission{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
 554                                 }else{
 555                                         $addattackpoint->execute($c->user->id);
 556                                         $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
 557                                         $mission{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
 558                                         $log->execute($c->user->id,"Gave attack point for confirmation on $mission mission to $x:$y:$z, landing tick $tick");
 559                                 }
 560                         }elsif ($mission eq 'Defend'){
 561                                 my $call = $findtarget->fetchrow_hashref;
 562                                 $informDefChannel->execute($fleet,$call->{call});
 563                         }
 564
 565                         $log->execute($c->user->id,"Pasted confirmation for $mission mission to $x:$y:$z, landing tick $tick");
 566                         push @missions,\%mission;
 567                 }
 568                 $dbh->commit;
 569                 $c->flash(missions => \@missions);
 570         };
 571         if ($@){
 572                 $dbh->rollback;
 573                 if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 574                         $c->flash( error => "'$1' is NOT a valid ship");
 575                 }else{
 576                         $c->flash( error => $@);
 577                 }
 578         }
 579
 580         $c->res->redirect($c->uri_for('launchConfirmation'));
 581 }
 582
 583 sub defenders : Local {
 584         my ( $self, $c, $order ) = @_;
 585         my $dbh = $c->model;
 586
 587         my $defenders = $dbh->prepare(q{
 588 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
 589         ,sms_note, call_if_needed, race, timezone
 590 FROM users u
 591         JOIN current_planet_stats p USING (pid)
 592 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 593 ORDER BY call_if_needed DESC, username
 594                 });
 595         $defenders->execute;
 596
 597         my $available = $dbh->prepare(q{
 598 SELECT ship,amount FROM available_ships WHERE pid = $1
 599                 });
 600
 601         my @members;
 602         while (my $member = $defenders->fetchrow_hashref){
 603
 604                 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
 605                 $available->execute($member->{planet});
 606                 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
 607                         , ships => $available->fetchall_arrayref({})
 608                 };
 609                 push @{$member->{fleets}}, $fleet;
 610                 push @members,$member;
 611         }
 612         $c->stash(members => \@members);
 613 }
 614
 615 sub member_fleets {
 616         my ( $dbh, $uid, $planet ) = @_;
 617
 618         my $query = $dbh->prepare(q{
 619 (
 620         SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
 621                 ,amount, NULL AS coords, pid AS target, NULL AS back
 622                 ,NULL AS recalled, mission
 623         FROM fleets f
 624         WHERE pid = $2 AND tick <= tick() AND tick >= tick() -  24
 625                 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
 626         ORDER BY mission,name,tick DESC, fid DESC
 627 ) UNION (
 628         SELECT fid,name,landing_tick AS tick, eta, amount
 629                 , coords(x,y,z), lc.pid AS target, back
 630                 , (back <> landing_tick + eta - 1) AS recalled
 631                 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
 632                         THEN 'Returning' ELSE mission END AS mission
 633         FROM  launch_confirmations lc
 634                 LEFT OUTER JOIN current_planet_stats t USING (pid)
 635                 JOIN fleets f USING (fid)
 636         WHERE uid = $1 AND f.pid = $2 AND back > tick()
 637                 AND landing_tick - eta - 12 < tick()
 638 )
 639                 });
 640
 641         my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
 642                 WHERE fid = ? ORDER BY num
 643                 });
 644
 645         $query->execute($uid,$planet);
 646         my @fleets;
 647         while (my $fleet = $query->fetchrow_hashref){
 648                 my @ships;
 649                 $ships->execute($fleet->{fid});
 650                 while (my $ship = $ships->fetchrow_hashref){
 651                         push @ships,$ship;
 652                 }
 653                 $fleet->{ships} = \@ships;
 654                 push @fleets,$fleet;
 655         }
 656         return \@fleets;
 657 }
 658
 659 =head1 AUTHOR
 660
 661 Michael Andreen (harv@ruin.nu)
 662
 663 =head1 LICENSE
 664
 665 GPL 2.0, or later.
 666
 667 =cut
 668
 669 1;