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