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