lib/NDWeb/Controller/Members.pm

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