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