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