]> ruin.nu Git - ndwebbie.git/blob - lib/NDWeb/Controller/Members.pm
0751b4040979fc992e90bc0ed6bc2650589a9307
[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 =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\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 @missions;
581         $missions =~ s/,//g;
582         if ($missions =~ m/
583                 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+
584                 (?<ships>.+?)
585                 \QTotal Ships in Fleet\E \s?\t (\d+) \s?\t (?<amount>\d+) \s?\t (?<amount>\d+) \s?\t (?<amount>\d+) \W+
586                 Mission: \t (?<mission>\w*) \t (?<mission>\w*) \t (?<mission>\w*) \W+
587                 Target: \t (?<target>\d+:\d+:\d+)? \t (?<target>\d+:\d+:\d+)? \t (?<target>\d+:\d+:\d+)? \W+
588                 \QLaunch Tick:\E \t (?<lt>\d*) \t (?<lt>\d*) \t (?<lt>\d*) \W+
589                 ETA: \t (?<eta>[^\t]*) \t (?<eta>[^\t]*) \t (?<eta>[^\t]*)
590                 /sx){
591                 my %match = %-;
592                 for my $i (0..2){
593                         my %mission = (
594                                 name => $match{name}->[$i],
595                                 mission => $match{mission}->[$i],
596                                 target => $match{target}->[$i],
597                                 amount => $match{amount}->[$i],
598                                 lt => $match{lt}->[$i],
599                                 num => $i,
600                                 ships => []
601                         );
602                         given($match{eta}->[$i]){
603                                 when(/(\d+) (\s+ \(\+\d+\))? \W+
604                                                 Arrival:\ (\d+) \W+
605                                                 \QReturn ETA: \E(Instant|\d+)/sx){
606                                         $mission{tick} = $3;
607                                         $mission{eta} = $1 + $4;
608                                         $mission{back} = $3 + $mission{eta} - 1;
609                                 }
610                                 when(/(\d+) \W+
611                                         Arrival:\ (\d+)/sx){
612                                         $mission{tick} = $2;
613                                         $mission{eta} = $1;
614                                         $mission{back} = $2;
615                                 }
616                         }
617                         push @missions,\%mission;
618                 }
619                 push @missions,{
620                         name => 'Main',
621                         num => 3,
622                         mission => 'Full fleet',
623                         tick => $tick,
624                         amount => 0,
625                         ships => []
626                 };
627                 while ($match{ships}->[0] =~ m/((?:\w+ )*\w+)\s+(FI|CO|FR|DE|CR|BS)[^\d]+([\d\s]+)/g){
628                         my $ship = $1;
629                         my @amounts = split /\D+/, $3;
630                         my $amount = shift @amounts;
631                         die "Ships don't sum up properly" if $amounts[3] != $amount + $amounts[0] + $amounts[1] + $amounts[2];
632                         for my $i (0..3){
633                                 push @{$missions[$i]->{ships}},{ship => $ship, amount => $amounts[$i]} if $amounts[$i] > 0;
634                         }
635                         $missions[3]->{amount} += $amounts[3];
636                 }
637         }
638         return @missions;
639 }
640
641 sub findDuplicateFleet : Private {
642         my ( $self, $c, $m ) = @_;
643         my $dbh = $c->model;
644
645         my $findfleet = $dbh->prepare(q{
646 SELECT fid FROM fleets f
647         LEFT JOIN launch_confirmations lc USING (fid)
648 WHERE f.pid = (SELECT pid FROM users WHERE uid = $1) AND mission = $3 AND amount = $4 AND
649         COALESCE(uid = $1 AND num = $2 AND lc.pid = $5 AND landing_tick = $6, TRUE)
650                 });
651         my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{num}
652                 ,$m->{mission},$m->{amount}, $m->{pid}, $m->{tick});
653         $c->forward("matchShips", [$m,$fid]);
654         $m->{fid} = $fid if $m->{match};
655 }
656
657 sub addAttackFleet : Private {
658         my ( $self, $c, $m ) = @_;
659         my $dbh = $c->model;
660
661         my $findattacktarget = $dbh->prepare(q{
662 SELECT c.target,c.wave,c.launched
663 FROM  raid_claims c
664         JOIN raid_targets t ON c.target = t.id
665         JOIN raids r ON t.raid = r.id
666 WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
667         AND r.open AND not r.removed
668                 });
669         my $launchedtarget = $dbh->prepare(q{
670 UPDATE raid_claims SET launched = TRUE
671 WHERE uid = ? AND target = ? AND wave = ?
672                 });
673         my $claim = $dbh->selectrow_hashref($findattacktarget,undef,$c->user->id,$m->{tick},$m->{pid});
674         if ($claim->{launched}){
675                 $m->{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
676         }elsif(defined $claim->{launched}){
677                 $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
678                 $m->{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
679         }else{
680                 $m->{warning} = "You haven't claimed this target";
681         }
682 }
683
684 sub addDefendFleet : Private {
685         my ( $self, $c, $m ) = @_;
686         my $dbh = $c->model;
687
688         my $finddefensetarget = $dbh->prepare(q{
689 SELECT call FROM calls c
690         JOIN users u USING (uid)
691 WHERE u.pid = $1 AND c.landing_tick = $2
692         });
693         my $informDefChannel = $dbh->prepare(q{
694 INSERT INTO defense_missions (fleet,call) VALUES (?,?)
695                 });
696         my $call = $dbh->selectrow_hashref($finddefensetarget,undef,$m->{pid},$m->{tick});
697         if ($call->{call}){
698                 $informDefChannel->execute($m->{fleet},$call->{call});
699         }else{
700                 $m->{warning} = "No call for $m->{target} landing tick $m->{tick}";
701         }
702 }
703
704 sub addReturnFleet : Private {
705         my ( $self, $c, $m ) = @_;
706         my $dbh = $c->model;
707
708         my $findfleet = $dbh->prepare(q{
709 SELECT fid FROM fleets f
710         JOIN launch_confirmations lc USING (fid)
711 WHERE uid = $1 AND num = $2  AND amount = $3
712         AND back >= $4
713                 });
714         my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{num}
715                 ,$m->{amount}, $m->{tick});
716         $c->forward("matchShips", [$m,$fid]);
717         if ($m->{match}){
718                 $m->{fid} = $fid;
719                 $m->{warning} = "Return fleet, changed back tick to match the return eta.";
720         } else {
721                 $m->{warning} = "Couldn't find a fleet matching this returning fleet, so adding a new fleet that is returning";
722         }
723 }
724
725 sub matchShips : Private {
726         my ( $self, $c, $m, $fid ) = @_;
727         return unless $fid;
728         my $dbh = $c->model;
729
730         my $ships = $dbh->prepare(q{
731 SELECT ship, amount FROM fleet_ships WHERE fid = $1 ORDER BY num
732                 });
733         $ships->execute($fid);
734         for my $s (@{$m->{ships}}){
735                 my $s2 = $ships->fetchrow_hashref;
736                 return unless $s->{ship} eq $s2->{ship} && $s->{amount} == $s2->{amount};
737         }
738         $m->{match} = 1;
739
740 }
741
742 sub defenders : Local {
743         my ( $self, $c, $order ) = @_;
744         my $dbh = $c->model;
745
746         my $defenders = $dbh->prepare(q{
747 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
748         ,sms_note, call_if_needed, race, timezone
749 FROM users u
750         JOIN current_planet_stats p USING (pid)
751 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
752 ORDER BY call_if_needed DESC, username
753                 });
754         $defenders->execute;
755
756         my $available = $dbh->prepare(q{
757 SELECT ship,amount FROM available_ships WHERE pid = $1
758                 });
759
760         my @members;
761         while (my $member = $defenders->fetchrow_hashref){
762
763                 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
764                 $available->execute($member->{planet});
765                 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
766                         , ships => $available->fetchall_arrayref({})
767                 };
768                 push @{$member->{fleets}}, $fleet;
769                 push @members,$member;
770         }
771         $c->stash(members => \@members);
772 }
773
774 sub member_fleets {
775         my ( $dbh, $uid, $planet ) = @_;
776
777         my $query = $dbh->prepare(q{
778 (
779         SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
780                 ,amount, NULL AS coords, pid AS target, NULL AS back
781                 ,NULL AS recalled, mission
782         FROM fleets f
783         WHERE pid = $2 AND tick <= tick() AND tick >= tick() -  24
784                 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
785         ORDER BY mission,name,tick DESC, fid DESC
786 ) UNION (
787         SELECT fid,name,landing_tick AS tick, eta, amount
788                 , coords(x,y,z), lc.pid AS target, back
789                 , (back <> landing_tick + eta - 1) AS recalled
790                 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
791                         THEN 'Returning' ELSE mission END AS mission
792         FROM  launch_confirmations lc
793                 LEFT OUTER JOIN current_planet_stats t USING (pid)
794                 JOIN fleets f USING (fid)
795         WHERE uid = $1 AND f.pid = $2 AND back > tick()
796                 AND landing_tick - eta - 12 < tick()
797 )
798                 });
799
800         my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
801                 WHERE fid = ? ORDER BY num
802                 });
803
804         $query->execute($uid,$planet);
805         my @fleets;
806         while (my $fleet = $query->fetchrow_hashref){
807                 my @ships;
808                 $ships->execute($fleet->{fid});
809                 while (my $ship = $ships->fetchrow_hashref){
810                         push @ships,$ship;
811                 }
812                 $fleet->{ships} = \@ships;
813                 push @fleets,$fleet;
814         }
815         return \@fleets;
816 }
817
818 =head1 AUTHOR
819
820 Michael Andreen (harv@ruin.nu)
821
822 =head1 LICENSE
823
824 GPL 2.0, or later.
825
826 =cut
827
828 1;