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