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