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