1 package NDWeb::Controller::Members;
6 use parent 'Catalyst::Controller';
12 NDWeb::Controller::Members - Catalyst Controller
27 sub index : Path : Args(0) {
28 my ( $self, $c, $order ) = @_;
31 $c->stash(error => $c->flash->{error});
33 $c->stash(u => $dbh->selectrow_hashref(q{SELECT pid AS planet,defense_points
34 ,attack_points,scan_points,humor_points
35 , (attack_points+defense_points+scan_points/20)::NUMERIC(5,1) as total_points
36 , sms,rank,hostmask,call_if_needed,sms_note,defprio
37 FROM users_defprio WHERE uid = ?
41 $c->stash(groups => $dbh->selectrow_array(q{SELECT array_agg(groupname)
42 FROM groups g NATURAL JOIN groupmembers gm
47 $c->stash(p => $dbh->selectrow_hashref(q{SELECT pid AS id,x,y,z, ruler, planet,race,
48 size, size_gain, size_gain_day,
49 score,score_gain,score_gain_day,
50 value,value_gain,value_gain_day,
51 xp,xp_gain,xp_gain_day,
52 sizerank,sizerank_gain,sizerank_gain_day,
53 scorerank,scorerank_gain,scorerank_gain_day,
54 valuerank,valuerank_gain,valuerank_gain_day,
55 xprank,xprank_gain,xprank_gain_day
56 from current_planet_stats_full p
58 },undef,$c->user->planet)
61 my $calls = $dbh->prepare(q{
62 SELECT * FROM defcalls
63 WHERE uid = $1 AND landing_tick >= tick()
64 ORDER BY landing_tick DESC
66 $calls->execute($c->user->id);
67 $c->stash(calls => $calls->fetchall_arrayref({}) );
69 $c->stash(fleets => member_fleets($dbh, $c->user->id,$c->user->planet));
71 my $announcements = $dbh->prepare(q{SELECT ft.ftid, u.username,ft.subject,
72 count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts,
73 date_trunc('seconds',max(fp.time)::timestamp) as last_post,
74 min(fp.time)::date as posting_date, ft.sticky
75 FROM forum_threads ft JOIN forum_posts fp USING (ftid)
76 JOIN users u ON u.uid = ft.uid
77 LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $1) ftv ON ftv.ftid = ft.ftid
79 GROUP BY ft.ftid, ft.subject,ft.sticky,u.username
80 HAVING count(NULLIF(COALESCE(ft.sticky OR fp.time > ftv.time,TRUE),FALSE)) >= 1
81 ORDER BY sticky DESC,last_post DESC
83 $announcements->execute($c->user->id);
84 $c->stash(announcements => $announcements->fetchall_arrayref({}) );
87 sub posthostupdate : Local {
88 my ( $self, $c ) = @_;
91 $dbh->do(q{UPDATE users SET hostmask = ? WHERE uid = ?
92 },undef, html_escape $c->req->param('hostname'), $c->user->id);
94 $c->res->redirect($c->uri_for(''));
97 sub postsmsupdate : Local {
98 my ( $self, $c ) = @_;
101 my $callme = $c->req->param('callme') || 0;
103 UPDATE users SET sms = $1, call_if_needed = $2, sms_note = $3 WHERE uid = $4
104 },undef, html_escape $c->req->param('sms'),$callme
105 ,$c->req->param('smsnote'), $c->user->id);
107 $c->res->redirect($c->uri_for(''));
110 sub postowncoords : Local {
111 my ( $self, $c ) = @_;
114 if ($c->user->planet){
115 $c->flash(error => 'You already have a planet set.'
116 .' Contact a HC if they need to be changed');
117 }elsif ($c->req->param('planet') =~ m/(\d+)\D+(\d+)\D+(\d+)/){
118 my $planet = $dbh->selectrow_array(q{SELECT planetid($1,$2,$3,TICK())
122 $dbh->do(q{UPDATE users SET planet = ? WHERE uid = ?
123 },undef, $planet , $c->user->id);
125 $c->flash(error => "No planet at coords: $1:$2:$3");
128 $c->flash(error => $c->req->param('planet') . " are not valid coords.");
131 $c->res->redirect($c->uri_for(''));
134 sub postfleetupdate : Local {
135 my ( $self, $c ) = @_;
138 my $fleet = $c->req->param('fleet');
142 while ($fleet =~ m/((?:[A-Z][a-z]+ )*[A-Z][a-z]+)\s+(\d+)/g){
144 push @ships, [$1,$2];
149 my $insert = $dbh->prepare(q{INSERT INTO fleets
150 (pid,name,mission,tick,amount)
151 VALUES (?,'Main','Full fleet',tick(),?) RETURNING fid});
152 my ($id) = $dbh->selectrow_array($insert,undef
153 ,$c->user->planet,$amount);
154 $insert = $dbh->prepare(q{INSERT INTO fleet_ships
155 (fid,ship,amount) VALUES (?,?,?)});
158 $insert->execute(@{$s});
160 $insert = $dbh->prepare(q{INSERT INTO full_fleets
161 (fid,uid) VALUES (?,?)});
162 $insert->execute($id,$c->user->id);
166 if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
167 $c->flash( error => "'$1' is NOT a valid ship");
169 $c->flash( error => $@);
174 $c->flash( error => 'Fleet does not contain any ships');
177 $c->res->redirect($c->uri_for(''));
180 sub postfleetsupdates : Local {
181 my ( $self, $c ) = @_;
184 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
185 (SELECT ftid FROM users WHERE uid = $1),$1,$2)
188 if ($c->req->param('cmd') eq 'Recall Fleets'){
189 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
190 SET back = tick() + (tick() - (landing_tick - eta))
191 WHERE uid = ? AND fid = ? AND back >= tick()+eta
194 for my $param ($c->req->param()){
195 if ($param =~ /^change:(\d+)$/){
196 $updatefleets->execute($c->user->id,$1);
197 $log->execute($c->user->id,"Member recalled fleet $1");
200 }elsif ($c->req->param('cmd') eq 'Change Fleets'){
201 my $updatefleets = $dbh->prepare(q{UPDATE launch_confirmations
202 SET back = ? WHERE uid = ? AND fid = ?});
204 for my $param ($c->req->param()){
205 if ($param =~ /^change:(\d+)$/){
206 my $back = $c->req->param("back:$1");
207 $updatefleets->execute($back,$c->user->id,$1);
208 $log->execute($c->user->id,"Member set fleet $1 to be back tick: $back");
214 $c->res->redirect($c->uri_for(''));
217 sub ircrequest : Local {
218 my ( $self, $c ) = @_;
221 $c->stash(reply => $c->flash->{reply});
222 $c->stash(channels => ['scan','members','def']);
225 sub postircrequest : Local {
226 my ( $self, $c ) = @_;
229 if ($c->req->param('channel')){
230 my $query = $dbh->prepare(q{
231 INSERT INTO irc_requests (uid,channel,message) VALUES($1,$2,$3)
233 $query->execute($c->user->id,$c->req->param('channel'),$c->req->param('message'));
234 system 'killall','-USR1', 'irssi';
236 $c->flash(reply => "Msg sent to: ".$c->req->param('channel'));
237 $c->res->redirect($c->uri_for('ircrequest'));
239 $c->stash(ircmessage => $c->req->param('message'));
240 $c->go('ircrequest');
245 my ( $self, $c, $order ) = @_;
248 if ($order ~~ /^((?:defense|attack|total|humor|scan|raid)_points)$/
249 || $order ~~ /^(defprio)$/){
252 $order = 'total_points DESC';
255 my $limit = 'LIMIT 10';
256 $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
258 my $query = $dbh->prepare(q{
259 SELECT username,defense_points,attack_points
260 ,scan_points,humor_points,defprio
261 ,(attack_points+defense_points+scan_points/20)::NUMERIC(4,0) as total_points
262 , count(NULLIF(rc.launched,FALSE)) AS raid_points
263 FROM users_defprio u LEFT OUTER JOIN raid_claims rc USING (uid)
264 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 2)
265 GROUP BY username,defense_points,attack_points,scan_points,humor_points,defprio
266 ORDER BY } . "$order $limit"
269 $c->stash(members => $query->fetchall_arrayref({}));
273 my ( $self, $c, $order ) = @_;
276 if ($order ~~ /^(scre|value|xp|size|race)$/){
279 $order = 'scorerank';
281 $order .= ',race' if $order eq 'racerank';
283 my $limit = 'LIMIT 10';
284 $limit = '' if $c->check_user_roles(qw/members_points_nolimit/);
286 my ($races) = $dbh->selectrow_array(q{SELECT enum_range(null::race)::text[]});
287 $c->stash(races => $races);
288 my $query = $dbh->prepare(q{
290 ,rank() OVER(ORDER BY score DESC) AS scorerank
291 ,rank() OVER(ORDER BY value DESC) AS valuerank
292 ,rank() OVER(ORDER BY xp DESC) AS xprank
293 ,rank() OVER(ORDER BY size DESC) AS sizerank
294 ,rank() OVER(PARTITION BY race ORDER BY score DESC) AS racerank
296 FROM current_planet_stats
297 WHERE alliance = 'NewDawn'
299 ORDER BY } . "$order $limit");
300 my @race = $c->req->param('race');
301 my %race = map { $_ => 1 } @race;
302 $c->stash(race => \%race);
306 $query->execute(\@race);
307 $c->stash(members => $query->fetchall_arrayref({}));
310 sub addintel : Local {
311 my ( $self, $c, $order ) = @_;
313 $c->stash(intel => $c->flash->{intel});
314 $c->stash(scans => $c->flash->{scans});
315 $c->stash(intelmessage => $c->flash->{intelmessage});
318 sub postintel : Local {
319 my ( $self, $c, $order ) = @_;
321 $c->forward('insertintel');
323 $c->res->redirect($c->uri_for('addintel'));
326 sub postintelmessage : Local {
327 my ( $self, $c, $order ) = @_;
329 unless ($c->req->param('subject')){
330 if ($c->req->param('message') =~ /(.*\w.*)/){
331 $c->req->param(subject => $1);
335 $c->forward('/forum/insertThread',[12]);
336 $c->forward('/forum/insertPost',[$c->stash->{thread}]);
337 $c->flash(intelmessage => 1);
339 $c->forward('insertintel');
341 $c->res->redirect($c->uri_for('addintel'));
344 sub insertintel : Private {
345 my ( $self, $c, $order ) = @_;
349 my $findscan = $dbh->prepare(q{SELECT scan_id FROM scans
350 WHERE scan_id = LOWER(?) AND tick >= tick() - 168 AND groupscan = ?
352 my $addscan = $dbh->prepare(q{INSERT INTO scans (scan_id,tick,uid,groupscan)
353 VALUES (LOWER(?),tick(),?,?)
355 my $addpoint = $dbh->prepare(q{UPDATE users SET scan_points = scan_points + 1
359 my $intel = $c->req->param('message');
360 while ($intel =~ m{http://[\w.]+/.+?scan(_id|_grp)?=(\w+)}g){
361 my $groupscan = (defined $1 && $1 eq '_grp') || 0;
364 $scan{group} = $groupscan;
365 $findscan->execute($2,$groupscan);
366 if ($findscan->rows == 0){
367 if ($addscan->execute($2,$c->user->id,$groupscan)){
368 $addpoint->execute($c->user->id) unless $groupscan;
372 $scan{message} = 'already exists';
376 my $tick = $c->req->param('tick');
377 unless ($tick =~ /^(\d+)$/){
378 $tick = $c->stash->{game}->{tick};
380 my $addintel = $dbh->prepare(q{INSERT INTO intel
381 (name,mission,tick,target,sender,eta,amount,ingal,back,uid)
382 VALUES($1,$2,$3,planetid($4,$5,$6,$10),planetid($7,$8,$9,$10)
383 ,$11,$12,$13,$14,$15)
386 while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)
387 \*?\s+(.+)(?:Ter|Cat|Xan|Zik|Etd)?
388 \s+(\d+)\s+(Attack|Defend)\s+(\d+)/gx){
389 my $ingal = ($1 == $4 && $2 == $5) || 0;
390 my $lt = $tick + $10;
391 my $back = ($ingal ? $lt + 4 : undef);
393 $addintel->execute($7,$9,$lt,$1,$2,$3,$4,$5,$6,$tick,$10,$8
394 ,$ingal,$back, $c->user->id);
395 push @intel,"Added $&";
398 push @intel,"Couldn't add $&: ".$dbh->errstr;
402 $c->flash(intel => \@intel);
403 $c->flash(scans => \@scans);
406 sub launchConfirmation : Local {
407 my ( $self, $c ) = @_;
409 $c->stash(error => $c->flash->{error});
410 $c->stash(missions => $c->flash->{missions});
413 sub postconfirmation : Local {
414 my ( $self, $c ) = @_;
418 my $missions = $c->req->param('mission');
419 my $findplanet = $dbh->prepare("SELECT planetid(?,?,?,?)");
420 my $findattacktarget = $dbh->prepare(q{SELECT c.target,c.wave,c.launched
422 JOIN raid_targets t ON c.target = t.id
423 JOIN raids r ON t.raid = r.id
424 WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.pid = ?
425 AND r.open AND not r.removed
427 my $finddefensetarget = $dbh->prepare(q{SELECT call FROM calls c
428 JOIN users u USING (uid)
429 WHERE u.pid = $1 AND c.landing_tick = $2
431 my $informDefChannel = $dbh->prepare(q{INSERT INTO defense_missions
432 (fleet,call) VALUES (?,?)
434 my $addattackpoint = $dbh->prepare(q{UPDATE users SET
435 attack_points = attack_points + 1 WHERE uid = ?
437 my $launchedtarget = $dbh->prepare(q{UPDATE raid_claims SET launched = True
438 WHERE uid = ? AND target = ? AND wave = ?
440 my $addfleet = $dbh->prepare(q{INSERT INTO fleets
441 (name,mission,pid,tick,amount)
442 VALUES ($2,$3,(SELECT pid FROM users WHERE uid = $1),tick(),$4)
445 my $addconfirmation = $dbh->prepare(q{INSERT INTO launch_confirmations
446 (fid,uid,pid,landing_tick,eta,back) VALUES ($1,$2,$3,$4,$5,$6)
448 my $addships = $dbh->prepare(q{INSERT INTO fleet_ships (fid,ship,amount)
451 my $log = $dbh->prepare(q{INSERT INTO forum_posts (ftid,uid,message) VALUES(
452 (SELECT ftid FROM users WHERE uid = $1),$1,$2)
456 while ($missions && $missions =~ m/([^\n]+)\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)
457 \s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+
458 (Attack|Defend|Return|Fake\ Attack|Fake\ Defend)
460 (?:Launching\ in\ tick\ (\d+),\ arrival\ in\ tick\ (\d+)
461 |ETA:\ \d+,\ Return\ ETA:\ (\d+)
464 next if $10 eq 'Return';
467 my $tick = $c->stash->{TICK}+$9;
468 $tick += $8 if defined $8;
469 $tick = $13 if defined $13;
471 $eta += $14 if defined $14;
476 my $back = $tick + $eta - 1;
477 $mission{tick} = $tick;
478 $mission{mission} = $mission;
479 $mission{target} = "$x:$y:$z";
480 $mission{back} = $back;
482 my ($planet_id) = $dbh->selectrow_array($findplanet,undef,$x,$y,$z,$c->stash->{TICK});
484 my $findtarget = $finddefensetarget;
485 if ($mission eq 'Attack'){
486 $findtarget = $findattacktarget;
487 $findtarget->execute($c->user->id,$tick,$planet_id);
488 }elsif ($mission eq 'Defend'){
489 $findtarget = $finddefensetarget;
490 $findtarget->execute($planet_id,$tick);
496 while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+(?:(?:\w+|-)\s+){3}(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Structure Killer)\s+(\d+)/g){
498 push @ships,{ship => $1, amount => $2};
500 $mission{ships} = \@ships;
503 warn "No ships in: $ships";
506 my $fleet = $dbh->selectrow_array($addfleet,undef,$c->user->id,$name
508 $addconfirmation->execute($fleet,$c->user->id,$planet_id,$tick,$eta,$back);
509 $mission{fleet} = $fleet;
510 for my $ship (@ships){
511 $addships->execute($fleet,$ship->{ship},$ship->{amount});
514 if ($findtarget->rows == 0){
515 $mission{warning} = 'No matching target!';
516 }elsif ($mission eq 'Attack'){
517 my $claim = $findtarget->fetchrow_hashref;
518 if ($claim->{launched}){
519 $mission{warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
521 $addattackpoint->execute($c->user->id);
522 $launchedtarget->execute($c->user->id,$claim->{target},$claim->{wave});
523 $mission{warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
524 $log->execute($c->user->id,"Gave attack point for confirmation on $mission mission to $x:$y:$z, landing tick $tick");
526 }elsif ($mission eq 'Defend'){
527 my $call = $findtarget->fetchrow_hashref;
528 $informDefChannel->execute($fleet,$call->{call});
531 $log->execute($c->user->id,"Pasted confirmation for $mission mission to $x:$y:$z, landing tick $tick");
532 push @missions,\%mission;
535 $c->flash(missions => \@missions);
539 if ($@ =~ m/insert or update on table "fleet_ships" violates foreign key constraint "fleet_ships_ship_fkey"\s+DETAIL:\s+Key \(ship\)=\(([^)]+)\)/){
540 $c->flash( error => "'$1' is NOT a valid ship");
542 $c->flash( error => $@);
546 $c->res->redirect($c->uri_for('launchConfirmation'));
549 sub defenders : Local {
550 my ( $self, $c, $order ) = @_;
553 my $defenders = $dbh->prepare(q{
554 SELECT uid,pid AS planet,username, to_char(NOW() AT TIME ZONE timezone,'HH24:MI') AS time
555 ,sms_note, call_if_needed, race, timezone
557 JOIN current_planet_stats p USING (pid)
558 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 2)
559 ORDER BY call_if_needed DESC, LOWER(username)
563 my $available = $dbh->prepare(q{
564 SELECT ship,amount FROM available_ships WHERE planet = $1
568 while (my $member = $defenders->fetchrow_hashref){
570 $member->{fleets} = member_fleets($dbh, $member->{uid}, $member->{planet});
571 $available->execute($member->{planet});
572 my $fleet = {fid => $member->{username}, mission => 'Available', name => 'At home'
573 , ships => $available->fetchall_arrayref({})
575 push @{$member->{fleets}}, $fleet;
576 push @members,$member;
578 $c->stash(members => \@members);
582 my ( $dbh, $uid, $planet ) = @_;
584 my $query = $dbh->prepare(q{
586 SELECT DISTINCT ON (mission,name) fid,name,tick, NULL AS eta
587 ,amount, NULL AS coords, pid AS target, NULL AS back
588 ,NULL AS recalled, mission
590 WHERE pid = $2 AND tick <= tick() AND tick >= tick() - 24
591 AND name IN ('Main','Advanced Unit') AND mission = 'Full fleet'
592 ORDER BY mission,name,tick DESC, fid DESC
594 SELECT fid,name,landing_tick AS tick, eta, amount
595 , coords(x,y,z), lc.pid AS target, back
596 , (back <> landing_tick + eta - 1) AS recalled
597 ,CASE WHEN landing_tick <= tick() OR (back <> landing_tick + eta - 1)
598 THEN 'Returning' ELSE mission END AS mission
599 FROM launch_confirmations lc
600 LEFT OUTER JOIN current_planet_stats t USING (pid)
601 JOIN fleets f USING (fid)
602 WHERE uid = $1 AND f.pid = $2 AND back > tick()
603 AND landing_tick - eta - 12 < tick()
607 my $ships = $dbh->prepare(q{SELECT ship,amount FROM fleet_ships
608 WHERE fid = ? ORDER BY num
611 $query->execute($uid,$planet);
613 while (my $fleet = $query->fetchrow_hashref){
615 $ships->execute($fleet->{fid});
616 while (my $ship = $ships->fetchrow_hashref){
619 $fleet->{ships} = \@ships;
627 Michael Andreen (harv@ruin.nu)