lib/NDWeb/Controller/Members.pm

   1 package NDWeb::Controller::Members;
   2
   3 use strict;
   4 use warnings;
   5 use feature ":5.10";
   6 use Try::Tiny;
   7 use parent 'Catalyst::Controller';
   8
   9 use NDWeb::Include;
  10
  11 =head1 NAME
  12
  13 NDWeb::Controller::Members - Catalyst Controller
  14
  15 =head1 DESCRIPTION
  16
  17 Catalyst Controller.
  18
  19 =head1 METHODS
  20
  21 =cut
  22
  23
  24 =head2 index
  25
  26 =cut
  27
  28 sub index : Path : Args(0) {
  29         my ( $self, $c, $order ) = @_;
  30         my $dbh = $c->model;
  31
  32         $c->stash(error => $c->flash->{error});
  33
  34         $c->stash(u => $dbh->selectrow_hashref(q{SELECT pid AS planet,defense_points
  35                         ,attack_points,scan_points,humor_points
  36                         , (attack_points+defense_points+scan_points/20)::NUMERIC(5,1) as total_points
  37                         , sms,rank,hostmask,call_if_needed,sms_note,defprio
  38                 FROM users_defprio WHERE uid = ?
  39                         },undef,$c->user->id)
  40         );
  41
  42         $c->stash(groups => $dbh->selectrow_array(q{SELECT array_agg(groupname)
  43                 FROM groups g NATURAL JOIN groupmembers gm
  44                 WHERE uid = $1
  45                         },undef,$c->user->id)
  46         );
  47
  48         $c->stash(p => $dbh->selectrow_hashref(q{SELECT pid AS id,x,y,z, ruler, planet,race,
  49                 size, size_gain, size_gain_day,
  50                 score,score_gain,score_gain_day,
  51                 value,value_gain,value_gain_day,
  52                 xp,xp_gain,xp_gain_day,
  53                 sizerank,sizerank_gain,sizerank_gain_day,
  54                 scorerank,scorerank_gain,scorerank_gain_day,
  55                 valuerank,valuerank_gain,valuerank_gain_day,
  56                 xprank,xprank_gain,xprank_gain_day
  57                 from current_planet_stats_full p
  58                         WHERE pid = ?
  59                         },undef,$c->user->planet)
  60         );
  61
  62         my $calls = $dbh->prepare(q{
  63 SELECT * FROM defcalls
  64 WHERE uid = $1 AND landing_tick >= tick()
  65 ORDER BY landing_tick DESC
  66                 });
  67         $calls->execute($c->user->id);
  68         $c->stash(calls => $calls->fetchall_arrayref({}) );
  69
  70         $c->stash(fleets => member_fleets($dbh, $c->user->id,$c->user->planet));
  71
  72         my $announcements = $dbh->prepare(q{SELECT ft.ftid, u.username,ft.subject,
  73                 count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts,
  74                 date_trunc('seconds',max(fp.time)::timestamp) as last_post,
  75                 min(fp.time)::date as posting_date, ft.sticky
  76                 FROM forum_threads ft JOIN forum_posts fp USING (ftid)
  77                         JOIN users u ON u.uid = ft.uid
  78                         LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $1) ftv ON ftv.ftid = ft.ftid
  79                 WHERE ft.fbid = 1
  80                 GROUP BY ft.ftid, ft.subject,ft.sticky,u.username
  81                 HAVING count(NULLIF(COALESCE(ft.sticky OR fp.time > ftv.time,TRUE),FALSE)) >= 1
  82                 ORDER BY sticky DESC,last_post DESC
  83                 });
  84         $announcements->execute($c->user->id);
  85         $c->stash(announcements => $announcements->fetchall_arrayref({}) );
  86
  87         my ($attackgroups) = $dbh->selectrow_array(q{
  88 SELECT array_agg(gid) FROM groupmembers WHERE gid IN ('x','y','z') AND uid = $1
  89                 }, undef, $c->user->id);
  90         $c->stash(attackgroups => $attackgroups);
  91
  92 }
  93
  94 sub posthostupdate : Local {
  95         my ( $self, $c ) = @_;
  96         my $dbh = $c->model;
  97
  98         $dbh->do(q{UPDATE users SET hostmask = ? WHERE uid = ?
  99                 },undef, html_escape $c->req->param('hostname'), $c->user->id);
 100
 101         $c->res->redirect($c->uri_for(''));
 102 }
 103
 104 sub postattackgroups : Local {
 105         my ( $self, $c ) = @_;
 106         my $dbh = $c->model;
 107
 108         my @groups = $c->req->param('class');
 109         $dbh->do(q{DELETE FROM groupmembers WHERE gid IN ('x','y','z') AND gid <> ALL($1) AND uid = $2
 110                 },undef, \@groups, $c->user->id);
 111
 112         $dbh->do(q{INSERT INTO groupmembers (uid,gid) (
 113                 SELECT $2, gid FROM unnest($1::text[]) AS gid WHERE gid IN ('x','y','z')
 114         EXCEPT
 115                 SELECT uid,gid FROM groupmembers WHERE uid = $2
 116                 )},undef, \@groups, $c->user->id);
 117
 118         $c->res->redirect($c->uri_for(''));
 119 }
 120
 121 sub postsmsupdate : Local {
 122         my ( $self, $c ) = @_;
 123         my $dbh = $c->model;
 124
 125         my $callme = $c->req->param('callme') || 0;
 126         $dbh->do(q{
 127 UPDATE users SET sms = $1, call_if_needed =  $2, sms_note = $3 WHERE uid = $4
 128                 },undef, html_escape $c->req->param('sms'),$callme
 129                 ,$c->req->param('smsnote'), $c->user->id);
 130
 131         $c->res->redirect($c->uri_for(''));
 132 }
 133
 134 sub postowncoords : Local {
 135         my ( $self, $c ) = @_;
 136         my $dbh = $c->model;
 137
 138         if ($c->user->planet){
 139                 $c->flash(error => 'You already have a planet set.'
 140                         .' Contact a HC if they need to be changed');
 141         }elsif (my ($x,$y,$z) = $c->req->param('planet') =~ m/(\d+)\D+(\d+)\D+(\d+)/){
 142                 my $planet = $dbh->selectrow_array(q{SELECT planetid($1,$2,$3,TICK())
 143                         },undef,$x,$y,$z);
 144
 145                 if ($planet){
 146                         eval {
 147                                 $dbh->do(q{UPDATE users SET pid = ? WHERE uid = ?
 148                                         },undef, $planet , $c->user->id);
 149                         };
 150                         given ($@){
 151                                 when (''){}
 152                                 when (/duplicate key value violates/){
 153                                         $c->flash(error => "The coords $x:$y:$z are already in use. Talk to hc if these are really your coords.")
 154                                 }
 155                                 default {
 156                                         $c->flash(error => $@)
 157                                 }
 158                         }
 159                 }else{
 160                         $c->flash(error => "No planet at coords: $x:$y:$z");
 161                 }
 162         }else{
 163                 $c->flash(error => $c->req->param('planet') . " are not valid coords.");
 164         }
 165
 166         $c->res->redirect($c->uri_for(''));
 167 }
 168
 169 sub postfleetupdate : Local {
 170         my ( $self, $c ) = @_;
 171         my $dbh = $c->model;
 172
 173         my $fleet = $c->req->param('fleet');
 174         $fleet =~ s/,//g;
 175         my $amount = 0;
 176         my @ships;
 177         while ($fleet =~ m/((?:[A-Z][a-z]+ )*[A-Z][a-z]+)\s+(\d+)/g){
 178                 $amount += $2;
 179                 push @ships, [$1,$2];
 180         }
 181         if ($amount){
 182                 $dbh->begin_work;
 183                 eval{
 184                         my $insert = $dbh->prepare(q{INSERT INTO fleets
 185                                 (pid,name,mission,tick,amount)
 186                                 VALUES (?,'Main','Full fleet',tick(),?) RETURNING fid});
 187                         my ($id) = $dbh->selectrow_array($insert,undef
 188                                 ,$c->user->planet,$amount);
 189                         $insert = $dbh->prepare(q{INSERT INTO fleet_ships
 190                                 (fid,ship,amount) VALUES (?,?,?)});
 191                         for my $s (@ships){
 192                                 unshift @{$s},$id;
 193                                 $insert->execute(@{$s});
 194                         }
 195                         $insert = $dbh->prepare(q{INSERT INTO full_fleets
 196                                 (fid,uid) VALUES (?,?)});
 197                         $insert->execute($id,$c->user->id);
 198                         $dbh->commit;
 199                 };
 200                 if ($@){
 201                         if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 202                                 $c->flash( error => "'$1' is NOT a valid ship");
 203                         }else{
 204                                 $c->flash( error => $@);
 205                         }
 206                         $dbh->rollback;
 207                 }
 208         }else{
 209                 $c->flash( error => 'Fleet does not contain any ships');
 210         }
 211
 212         $c->res->redirect($c->uri_for(''));
 213 }
 214
 215 sub postfleetsupdates : Local {
 216         my ( $self, $c ) = @_;
 217         my $dbh = $c->model;
 218
 219         my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 220                 (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 221                 });
 222         $dbh->begin_work;
 223         if ($c->req->param('cmd') eq 'Recall Fleets'){
 224                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 225                         SET back = tick() + (tick() - (landing_tick - eta))
 226                         WHERE uid = ? AND fid = ? AND back >= tick()+eta
 227                 });
 228
 229                 for my $param ($c->req->param()){
 230                         if ($param =~ /^change:(\d+)$/){
 231                                 $updatefleets->execute($c->user->id,$1);
 232                                 $log->execute($c->user->id,"Member recalled fleet $1");
 233                         }
 234                 }
 235         }elsif ($c->req->param('cmd') eq 'Change Fleets'){
 236                 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
 237                         SET back = ? WHERE uid = ? AND fid = ?});
 238
 239                 for my $param ($c->req->param()){
 240                         if ($param =~ /^change:(\d+)$/){
 241                                 my $back = $c->req->param("back:$1");
 242                                 $updatefleets->execute($back,$c->user->id,$1);
 243                                 $log->execute($c->user->id,"Member set fleet $1 to be back tick: $back");
 244                         }
 245                 }
 246         }
 247         $dbh->commit;
 248
 249         $c->res->redirect($c->uri_for(''));
 250 }
 251
 252 sub ircrequest : Local {
 253         my ( $self, $c ) = @_;
 254         my $dbh = $c->model;
 255
 256         $c->stash(reply => $c->flash->{reply});
 257         $c->stash(channels => ['scan','members','def']);
 258 }
 259
 260 sub postircrequest : Local {
 261         my ( $self, $c ) = @_;
 262         my $dbh = $c->model;
 263
 264         if ($c->req->param('channel')){
 265                 my $query = $dbh->prepare(q{
 266 INSERT INTO irc_requests (uid,channel,message) VALUES($1,$2,$3)
 267                 });
 268                 $query->execute($c->user->id,$c->req->param('channel'),$c->req->param('message'));
 269                 $c->signal_bots;
 270
 271                 $c->flash(reply => "Msg sent to: ".$c->req->param('channel'));
 272                 $c->res->redirect($c->uri_for('ircrequest'));
 273         }else{
 274                 $c->stash(ircmessage => $c->req->param('message'));
 275                 $c->go('ircrequest');
 276         }
 277 }
 278
 279 sub points : Local {
 280         my ( $self, $c, $order ) = @_;
 281         my $dbh = $c->model;
 282
 283         $order //= 'total_points';
 284         if ($order ~~ /^((?:defense|attack|total|humor|scan|raid)_points)$/
 285                         || $order ~~ /^(defprio)$/){
 286                 $order = "$1 DESC";
 287         }else{
 288                 $order = 'total_points DESC';
 289         }
 290
 291         my $limit = 'LIMIT 10';
 292         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 293
 294         my $query = $dbh->prepare(q{
 295 SELECT username,defense_points,attack_points
 296         ,scan_points,humor_points,defprio
 297         ,(attack_points+defense_points+scan_points/20)::NUMERIC(4,0) as total_points
 298         , count(NULLIF(rc.launched,FALSE)) AS raid_points
 299 FROM users_defprio u LEFT OUTER JOIN raid_claims rc USING (uid)
 300 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 301 GROUP BY username,defense_points,attack_points,scan_points,humor_points,defprio
 302 ORDER BY } . "$order $limit"
 303         );
 304         $query->execute;
 305         $c->stash(members => $query->fetchall_arrayref({}));
 306 }
 307
 308 sub stats : Local {
 309         my ( $self, $c, $order ) = @_;
 310         my $dbh = $c->model;
 311
 312         $order //= 'score';
 313         if ($order ~~ /^(scre|value|xp|size|race)$/){
 314                 $order = "$1rank";
 315         }else{
 316                 $order = 'scorerank';
 317         }
 318         $order .= ',race' if $order eq 'racerank';
 319
 320         my $limit = 'LIMIT 10';
 321         $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
 322
 323         my ($races) = $dbh->selectrow_array(q{SELECT enum_range(null::race)::text[]});
 324         $c->stash(races => $races);
 325         my $query = $dbh->prepare(q{
 326 SELECT nick
 327         ,rank() OVER(ORDER BY score DESC) AS scorerank
 328         ,rank() OVER(ORDER BY value DESC) AS valuerank
 329         ,rank() OVER(ORDER BY xp DESC) AS xprank
 330         ,rank() OVER(ORDER BY size DESC) AS sizerank
 331         ,rank() OVER(PARTITION BY race ORDER BY score DESC) AS racerank
 332         ,race
 333 FROM current_planet_stats
 334 WHERE alliance = 'NewDawn'
 335         AND race = ANY($1)
 336 ORDER BY } . "$order $limit");
 337         my @race = $c->req->param('race');
 338         my %race = map { $_ => 1 } @race;
 339         $c->stash(race => \%race);
 340         unless (@race){
 341                 @race = @$races;
 342         }
 343         $query->execute(\@race);
 344         $c->stash(members => $query->fetchall_arrayref({}));
 345 }
 346
 347 sub addintel : Local {
 348         my ( $self, $c, $order ) = @_;
 349
 350         $c->stash(intel => $c->flash->{intel});
 351         $c->stash(scans => $c->flash->{scans});
 352         $c->stash(intelmessage => $c->flash->{intelmessage});
 353 }
 354
 355 sub postintel : Local {
 356         my ( $self, $c, $order ) = @_;
 357
 358         $c->forward('insertintel');
 359
 360         $c->res->redirect($c->uri_for('addintel'));
 361 }
 362
 363 sub postintelmessage : Local {
 364         my ( $self, $c, $order ) = @_;
 365
 366         unless ($c->req->param('subject')){
 367                 if ($c->req->param('message') =~ /(.*\w.*)/){
 368                         $c->req->param(subject => $1);
 369                 }
 370         }
 371
 372         my ($coords,$tick) = $c->model->selectrow_array(q{
 373 SELECT coords(x,y,z), tick() FROM current_planet_stats WHERE pid = $1
 374                 }, undef, $c->user->planet);
 375
 376         $c->req->param(message => "[i]Posted by $coords at tick $tick [/i]\n\n" . $c->req->param('message'));
 377         $c->forward('/forum/insertThread',[12]);
 378         $c->forward('/forum/insertPost',[$c->stash->{thread}]);
 379         $c->flash(intelmessage => 1);
 380
 381         $c->forward('insertintel');
 382
 383         $c->res->redirect($c->uri_for('addintel'));
 384 }
 385
 386 sub insertintel : Private {
 387         my ( $self, $c, $order ) = @_;
 388         my $dbh = $c->model;
 389
 390         $dbh->begin_work;
 391         my $findscan = $dbh->prepare(q{SELECT scan_id FROM scans
 392                 WHERE scan_id = LOWER(?) AND tick >= tick() - 168 AND groupscan = ?
 393                 });
 394         my $addscan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid,groupscan)
 395                 VALUES (LOWER(?),tick(),?,?)
 396                 });
 397         my $addpoint = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + 1
 398                 WHERE uid = ?
 399                 });
 400         my @scans;
 401         my $intel = $c->req->param('message');
 402         while ($intel =~ m{http://[\w.]+/.+?scan(_id|_grp)?=(\w+)}g){
 403                 my $groupscan = (defined $1 && $1 eq '_grp') || 0;
 404                 my %scan;
 405                 $scan{id} = $2;
 406                 $scan{group} = $groupscan;
 407                 $findscan->execute($2,$groupscan);
 408                 if ($findscan->rows == 0){
 409                         if ($addscan->execute($2,$c->user->id,$groupscan)){
 410                                 $addpoint->execute($c->user->id) unless $groupscan;
 411                                 $scan{added} = 1;
 412                         }
 413                 }else{
 414                         $scan{message} = 'already exists';
 415                 }
 416                 push @scans,\%scan;
 417         }
 418         my $tick = $c->req->param('tick');
 419         unless ($tick =~ /^(\d+)$/){
 420                 $tick = $c->stash->{game}->{tick};
 421         }
 422         my $addintel = $dbh->prepare(q{INSERT INTO intel
 423                 (name,mission,tick,target,sender,eta,amount,ingal,back,uid)
 424                 VALUES($1,$2,$3,planetid($4,$5,$6,$10),planetid($7,$8,$9,$10)
 425                         ,$11,$12,$13,$14,$15)
 426         });
 427         my @intel;
 428         while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)
 429                 \*?\s+(.+)(?:Ter|Cat|Xan|Zik|Etd)?
 430                 \s+(\d+)\s+(Attack|Defend)\s+(\d+)/gx){
 431                 my $ingal = ($1 == $4 && $2 == $5) || 0;
 432                 my $lt = $tick + $10;
 433                 my $back = ($ingal ? $lt + 4 : undef);
 434                 eval {
 435                         $addintel->execute($7,$9,$lt,$1,$2,$3,$4,$5,$6,$tick,$10,$8
 436                                 ,$ingal,$back, $c->user->id);
 437                         push @intel,"Added $&";
 438                 };
 439                 if ($@){
 440                         push @intel,"Couldn't add $&: ".$dbh->errstr;
 441                 }
 442         }
 443         $dbh->commit;
 444         $c->flash(intel => \@intel);
 445         $c->flash(scans => \@scans);
 446 }
 447
 448 sub launchConfirmation : Local {
 449         my ( $self, $c ) = @_;
 450
 451         $c->stash(error => $c->flash->{error});
 452         $c->stash(missions => $c->flash->{missions});
 453 }
 454
 455 sub postconfirmation : Local {
 456         my ( $self, $c ) = @_;
 457         my $dbh = $c->model;
 458
 459         try {
 460                 my $findplanet = $dbh->prepare("SELECT planetid(?,?,?,?)");
 461                 my $addfleet = $dbh->prepare(q{INSERT INTO fleets
 462                         (name,mission,pid,tick,amount)
 463                         VALUES ($2,$3,(SELECT pid FROM users WHERE uid = $1),tick(),$4)
 464                         RETURNING fid
 465                         });
 466                 my $updatefleet = $dbh->prepare(q{
 467 UPDATE launch_confirmations SET back = $2 WHERE fid = $1
 468                         });
 469                 my $addconfirmation = $dbh->prepare(q{INSERT INTO launch_confirmations
 470                         (fid,uid,pid,landing_tick,eta,back) VALUES ($1,$2,$3,$4,$5,$6)
 471                         });
 472                 my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (fid,ship,amount)
 473                         VALUES (?,?,?)
 474                         });
 475                 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
 476                         (SELECT ftid FROM users WHERE uid = $1),$1,$2)
 477                         });
 478                 $dbh->begin_work;
 479                 my @missions = parseconfirmations($c->req->param('mission'), $c->stash->{TICK});
 480                 for my $m (@missions){
 481                         if ($m->{mission} eq 'Return'){
 482                                 $c->forward("addReturnFleet", [$m]);
 483                                 $updatefleet->execute($m->{fid},$m->{back}) if $m->{fid};
 484                                 next;
 485                         }
 486                         $m->{pid} = $dbh->selectrow_array($findplanet,undef,@{$m->{target}},$c->stash->{TICK});
 487                         unless ($m->{pid}){
 488                                 $m->{warning} = "No planet at @{$m->{target}}, try again next tick.";
 489                                 next;
 490                         }
 491
 492                         $c->forward("findDuplicateFleet", [$m]);
 493                         if ($m->{match}){
 494                                 $m->{warning} = "Already confirmed this fleet, changing back to to match this paste";
 495                                 $updatefleet->execute($m->{fid},$m->{back});
 496                                 next;
 497                         }
 498
 499                         $m->{fleet} = $dbh->selectrow_array($addfleet,undef,$c->user->id,$m->{name}
 500                                 ,$m->{mission},$m->{amount});
 501                         if ($m->{mission} eq 'Attack'){
 502                                 $c->forward("addAttackFleet", [$m]);
 503                         }elsif ($m->{mission} eq 'Defend'){
 504                                 $c->forward("addDefendFleet", [$m]);
 505                         }
 506
 507                         $addconfirmation->execute($m->{fleet},$c->user->id,$m->{pid},$m->{tick},$m->{eta},$m->{back});
 508
 509                         for my $ship (@{$m->{ships}}){
 510                                 $addships->execute($m->{fleet},$ship->{ship},$ship->{amount});
 511                         }
 512                         $log->execute($c->user->id,"Pasted confirmation for $m->{mission} mission to @{$m->{target}}, landing tick $m->{tick}");
 513                 }
 514                 $dbh->commit;
 515                 $c->flash(missions => \@missions);
 516                 $c->signal_bots;
 517         } catch {
 518                 $dbh->rollback;
 519                 when (/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
 520                         $c->flash( error => "'$1' is NOT a valid ship");
 521                 }
 522                 default{
 523                         $c->flash( error => $_);
 524                 }
 525         };
 526         $c->res->redirect($c->uri_for('launchConfirmation'));
 527 }
 528
 529 sub parseconfirmations {
 530         my ( $missions, $tick ) = @_;
 531         return unless $missions;
 532         my @missions;
 533         while ($missions =~ m/\s*([^\n]+?)\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)
 534                         \s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+
 535                         (Attack|Defend|Return|Fake\ Attack|Fake\ Defend)
 536                         (.*?)
 537                         (?:Launching\ in\ tick\ (\d+),\ arrival\ in\ tick\ (\d+)
 538                                 |ETA:\ \d+,\ Return\ ETA:\ (\d+)
 539                                 |Return\ ETA:\ (\d+)
 540                                 )/sgx){
 541                 my $tick = $tick;
 542                 $tick += $9;
 543                 $tick += $8 if defined $8;
 544                 $tick = $13 if defined $13;
 545                 my $eta = $9;
 546                 $eta += $14 if defined $14;
 547                 my %mission = (
 548                         name => $1,
 549                         mission => $10,
 550                         tick => $tick,
 551                         eta => $eta,
 552                         back => $10 eq 'Return' ? $tick : $tick + $eta - 1,
 553                         target => [$5,$6,$7],
 554                         from => [$2,$3,$4],
 555                 );
 556                 my $ships = $11;
 557                 my @ships;
 558                 $mission{amount} = 0;
 559                 while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+(?:(?:\w+|-)\s+){3}(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Structure Killer)\s+(\d+)/g){
 560                         $mission{amount} += $2;
 561                         push @ships,{ship => $1, amount => $2};
 562                 }
 563                 $mission{ships} = \@ships;
 564
 565                 if ($mission{amount} == 0){
 566                         warn "No ships in: $ships";
 567                         next;
 568                 }
 569                 push @missions,\%mission;
 570         }
 571         return @missions;
 572 }
 573
 574 sub findDuplicateFleet : Private {
 575         my ( $self, $c, $m ) = @_;
 576         my $dbh = $c->model;
 577
 578         my $findfleet = $dbh->prepare(q{
 579 SELECT fid FROM fleets f
 580         JOIN launch_confirmations lc USING (fid)
 581 WHERE uid = $1 AND name = $2 AND mission = $3 AND amount = $4
 582         AND lc.pid = $5 AND landing_tick = $6
 583                 });
 584         my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{name}
 585                 ,$m->{mission},$m->{amount}, $m->{pid}, $m->{tick});
 586         $c->forward("matchShips", [$m,$fid]);
 587         $m->{fid} = $fid if $m->{match};
 588 }
 589
 590 sub addAttackFleet : Private {
 591         my ( $self, $c, $m ) = @_;
 592         my $dbh = $c->model;
 593
 594         my $findattacktarget = $dbh->prepare(q{
 595 SELECT c.target,c.wave,c.launched
 596 FROM  raid_claims c
 597         JOIN raid_targets t ON c.target = t.id
 598         JOIN raids r ON t.raid = r.id
 599 WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
 600         AND r.open AND not r.removed
 601                 });
 602         my $launchedtarget = $dbh->prepare(q{
 603 UPDATE raid_claims SET launched = TRUE
 604 WHERE uid = ? AND target = ? AND wave = ?
 605                 });
 606         my $claim = $dbh->selectrow_hashref($findattacktarget,undef,$c->user->id,$m->{tick},$m->{pid});
 607         if ($claim->{launched}){
 608                 $m->{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
 609         }elsif(defined $claim->{launched}){
 610                 $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
 611                 $m->{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
 612         }else{
 613                 $m->{warning} = "You haven't claimed this target";
 614         }
 615 }
 616
 617 sub addDefendFleet : Private {
 618         my ( $self, $c, $m ) = @_;
 619         my $dbh = $c->model;
 620
 621         my $finddefensetarget = $dbh->prepare(q{
 622 SELECT call FROM calls c
 623         JOIN users u USING (uid)
 624 WHERE u.pid = $1 AND c.landing_tick = $2
 625         });
 626         my $informDefChannel = $dbh->prepare(q{
 627 INSERT INTO defense_missions (fleet,call) VALUES (?,?)
 628                 });
 629         my $call = $dbh->selectrow_hashref($finddefensetarget,undef,$m->{pid},$m->{tick});
 630         if ($call->{call}){
 631                 $informDefChannel->execute($m->{fleet},$call->{call});
 632         }else{
 633                 $m->{warning} = "No call for @{$m->{target}} landing tick $m->{tick}";
 634         }
 635 }
 636
 637 sub addReturnFleet : Private {
 638         my ( $self, $c, $m ) = @_;
 639         my $dbh = $c->model;
 640
 641         my $findfleet = $dbh->prepare(q{
 642 SELECT fid FROM fleets f
 643         JOIN launch_confirmations lc USING (fid)
 644 WHERE uid = $1 AND name = $2  AND amount = $3
 645         AND back >= $4
 646                 });
 647         my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{name}
 648                 ,$m->{amount}, $m->{tick});
 649         $c->forward("matchShips", [$m,$fid]);
 650         if ($m->{match}){
 651                 $m->{fid} = $fid;
 652                 $m->{warning} = "Return fleet, changed back tick to match the return eta.";
 653         } else {
 654                 $m->{warning} = "Couldn't find a fleet matching this returning fleet. Recall manually.";
 655         }
 656 }
 657
 658 sub matchShips : Private {
 659         my ( $self, $c, $m, $fid ) = @_;
 660         return unless $fid;
 661         my $dbh = $c->model;
 662
 663         my $ships = $dbh->prepare(q{
 664 SELECT ship, amount FROM fleet_ships WHERE fid = $1 ORDER BY num
 665                 });
 666         $ships->execute($fid);
 667         for my $s (@{$m->{ships}}){
 668                 my $s2 = $ships->fetchrow_hashref;
 669                 return unless $s->{ship} eq $s2->{ship} && $s->{amount} == $s2->{amount};
 670         }
 671         $m->{match} = 1;
 672
 673 }
 674
 675 sub defenders : Local {
 676         my ( $self, $c, $order ) = @_;
 677         my $dbh = $c->model;
 678
 679         my $defenders = $dbh->prepare(q{
 680 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
 681         ,sms_note, call_if_needed, race, timezone
 682 FROM users u
 683         JOIN current_planet_stats p USING (pid)
 684 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 685 ORDER BY call_if_needed DESC, username
 686                 });
 687         $defenders->execute;
 688
 689         my $available = $dbh->prepare(q{
 690 SELECT ship,amount FROM available_ships WHERE pid = $1
 691                 });
 692
 693         my @members;
 694         while (my $member = $defenders->fetchrow_hashref){
 695
 696                 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
 697                 $available->execute($member->{planet});
 698                 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
 699                         , ships => $available->fetchall_arrayref({})
 700                 };
 701                 push @{$member->{fleets}}, $fleet;
 702                 push @members,$member;
 703         }
 704         $c->stash(members => \@members);
 705 }
 706
 707 sub member_fleets {
 708         my ( $dbh, $uid, $planet ) = @_;
 709
 710         my $query = $dbh->prepare(q{
 711 (
 712         SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
 713                 ,amount, NULL AS coords, pid AS target, NULL AS back
 714                 ,NULL AS recalled, mission
 715         FROM fleets f
 716         WHERE pid = $2 AND tick <= tick() AND tick >= tick() -  24
 717                 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
 718         ORDER BY mission,name,tick DESC, fid DESC
 719 ) UNION (
 720         SELECT fid,name,landing_tick AS tick, eta, amount
 721                 , coords(x,y,z), lc.pid AS target, back
 722                 , (back <> landing_tick + eta - 1) AS recalled
 723                 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
 724                         THEN 'Returning' ELSE mission END AS mission
 725         FROM  launch_confirmations lc
 726                 LEFT OUTER JOIN current_planet_stats t USING (pid)
 727                 JOIN fleets f USING (fid)
 728         WHERE uid = $1 AND f.pid = $2 AND back > tick()
 729                 AND landing_tick - eta - 12 < tick()
 730 )
 731                 });
 732
 733         my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
 734                 WHERE fid = ? ORDER BY num
 735                 });
 736
 737         $query->execute($uid,$planet);
 738         my @fleets;
 739         while (my $fleet = $query->fetchrow_hashref){
 740                 my @ships;
 741                 $ships->execute($fleet->{fid});
 742                 while (my $ship = $ships->fetchrow_hashref){
 743                         push @ships,$ship;
 744                 }
 745                 $fleet->{ships} = \@ships;
 746                 push @fleets,$fleet;
 747         }
 748         return \@fleets;
 749 }
 750
 751 =head1 AUTHOR
 752
 753 Michael Andreen (harv@ruin.nu)
 754
 755 =head1 LICENSE
 756
 757 GPL 2.0, or later.
 758
 759 =cut
 760
 761 1;