Allow new full fleets if the old one is a few ticks old

[ndwebbie.git] / lib / NDWeb / Controller / Members.pm

diff --git a/lib/NDWeb/Controller/Members.pm b/lib/NDWeb/Controller/Members.pm
index 0751b4040979fc992e90bc0ed6bc2650589a9307..a7f6fb3020622150664e18463df8c12307150e78 100644 (file)
--- a/lib/NDWeb/Controller/Members.pm
+++ b/lib/NDWeb/Controller/Members.pm
@@ -83,12 +83,6 @@ ORDER BY landing_tick DESC
                });
        $announcements->execute($c->user->id);
        $c->stash(announcements => $announcements->fetchall_arrayref({}) );
-
-       my ($attackgroups) = $dbh->selectrow_array(q{
-SELECT array_agg(gid) FROM groupmembers WHERE gid IN ('x','y','z') AND uid = $1
-               }, undef, $c->user->id);
-       $c->stash(attackgroups => $attackgroups);
-
 }
 
 sub posthostupdate : Local {
@@ -101,23 +95,6 @@ sub posthostupdate : Local {
        $c->res->redirect($c->uri_for(''));
 }
 
-sub postattackgroups : Local {
-       my ( $self, $c ) = @_;
-       my $dbh = $c->model;
-
-       my @groups = $c->req->param('class');
-       $dbh->do(q{DELETE FROM groupmembers WHERE gid IN ('x','y','z') AND gid <> ALL($1) AND uid = $2
-               },undef, \@groups, $c->user->id);
-
-       $dbh->do(q{INSERT INTO groupmembers (uid,gid) (
-               SELECT $2, gid FROM unnest($1::text[]) AS gid WHERE gid IN ('x','y','z')
-       EXCEPT
-               SELECT uid,gid FROM groupmembers WHERE uid = $2
-               )},undef, \@groups, $c->user->id);
-
-       $c->res->redirect($c->uri_for(''));
-}
-
 sub postsmsupdate : Local {
        my ( $self, $c ) = @_;
        my $dbh = $c->model;
@@ -430,7 +407,7 @@ INSERT INTO irc_requests (uid,channel,message) VALUES($1,'def',$2)
                });
 
        my $msg = $c->req->param('message');
-       while ($msg =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\s+(\d+)/gc
+       while ($msg =~ /expand\s+(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+(\d+)/gc
                        || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/gc){
 
                my $inc = {message => $&};
@@ -584,30 +561,38 @@ sub parseconfirmations {
                (?<ships>.+?)
                \QTotal Ships in Fleet\E \s?\t (\d+) \s?\t (?<amount>\d+) \s?\t (?<amount>\d+) \s?\t (?<amount>\d+) \W+
                Mission: \t (?<mission>\w*) \t (?<mission>\w*) \t (?<mission>\w*) \W+
-               Target: \t (?<target>\d+:\d+:\d+)? \t (?<target>\d+:\d+:\d+)? \t (?<target>\d+:\d+:\d+)? \W+
-               \QLaunch Tick:\E \t (?<lt>\d*) \t (?<lt>\d*) \t (?<lt>\d*) \W+
-               ETA: \t (?<eta>[^\t]*) \t (?<eta>[^\t]*) \t (?<eta>[^\t]*)
+               Target: \t (?<targets>((\d+:\d+:\d+)?\t)*) \W+
+               \QLaunch Tick:\E \t (?<lts>(\d*\t)*) \W+
+               ETA: \t? (?<etas>([^\t]+\t?)*)
                /sx){
                my %match = %-;
+               my @etas = split /\t/, $+{etas};
+               my @targets = split /\t/, $+{targets};
+               my @lts = split /\t/, $+{lts};
                for my $i (0..2){
                        my %mission = (
                                name => $match{name}->[$i],
                                mission => $match{mission}->[$i],
-                               target => $match{target}->[$i],
                                amount => $match{amount}->[$i],
-                               lt => $match{lt}->[$i],
                                num => $i,
                                ships => []
                        );
-                       given($match{eta}->[$i]){
-                               when(/(\d+) (\s+ \(\+\d+\))? \W+
+                       if      ($mission{amount} == 0){
+                               push @missions,\%mission;
+                               next;
+                       }
+
+                       $mission{target} = shift @targets;
+                       $mission{lt} = shift @lts;
+                       given(shift @etas){
+                               when(/^(\d+) (\s+ \(\+\d+\))? \W+
                                                Arrival:\ (\d+) \W+
                                                \QReturn ETA: \E(Instant|\d+)/sx){
                                        $mission{tick} = $3;
                                        $mission{eta} = $1 + $4;
                                        $mission{back} = $3 + $mission{eta} - 1;
                                }
-                               when(/(\d+) \W+
+                               when(/^(\d+) \W+
                                        Arrival:\ (\d+)/sx){
                                        $mission{tick} = $2;
                                        $mission{eta} = $1;
@@ -645,8 +630,9 @@ sub findDuplicateFleet : Private {
        my $findfleet = $dbh->prepare(q{
 SELECT fid FROM fleets f
        LEFT JOIN launch_confirmations lc USING (fid)
-WHERE f.pid = (SELECT pid FROM users WHERE uid = $1) AND mission = $3 AND amount = $4 AND
-       COALESCE(uid = $1 AND num = $2 AND lc.pid = $5 AND landing_tick = $6, TRUE)
+WHERE f.pid = (SELECT pid FROM users WHERE uid = $1)
+       AND mission = $3 AND amount = $4 AND tick > $6 - 6
+       AND COALESCE(uid = $1 AND num = $2 AND lc.pid = $5 AND landing_tick = $6, TRUE)
                });
        my $fid = $dbh->selectrow_array($findfleet,undef,$c->user->id,$m->{num}
                ,$m->{mission},$m->{amount}, $m->{pid}, $m->{tick});