]> ruin.nu Git - NDIRC.git/blobdiff - Commands/Def.pm
Basic conversion to POE::Component::IRC
[NDIRC.git] / Commands / Def.pm
index 74d0aa8dd85de111414620e2510cbb2d2483e983..e13758d4797964e6bdd0d8293c8f101c1a0717b8 100644 (file)
@@ -23,6 +23,8 @@ use strict;
 use warnings;
 use feature ':5.10';
 
+use CGI;
+
 use Moose;
 use MooseX::MethodAttributes;
 
@@ -35,8 +37,8 @@ sub anon
 
        my ($target,$mess) = $msg =~ /^(\S+) (.*)$/ or die 'ARGS';
 
-       $c->message("msg $target", "<b>$mess</b>");
-       $c->message("msg ".$c->channel, "<c03>$target << $mess</c>");
+       $c->message(privmsg => $target, "<b>$mess</b>");
+       $c->message(privmsg => $c->channel, "<c03>$target << $mess</c>");
 }
 
 sub defcall
@@ -51,33 +53,177 @@ sub defcall
        my $callinfo = "";
        if ($callnr){
                my $st = $dbh->prepare(q{
-SELECT covered
+SELECT status
        ,c.landing_tick - (SELECT value::integer FROM misc WHERE id = 'TICK') AS eta
-       ,concat(i.shiptype||'/') AS shiptype
+       ,array_to_string(array_agg(i.shiptype),'/') AS shiptype
 FROM calls c
-       JOIN incomings i ON i.call = c.id
+       JOIN incomings i USING (call)
        LEFT OUTER JOIN users dc ON dc.uid = c.dc
-       JOIN users u ON u.uid = c.member
-WHERE c.id = ?
-GROUP BY c.id,c.landing_tick,c.covered
+WHERE c.call = ?
+GROUP BY c.call,c.landing_tick,c.status
 ORDER BY c.landing_tick;
                });
                my $call = $dbh->selectrow_hashref($st,undef,$callnr);
-               unless (defined $call->{covered}){
+               unless (defined $call->{status}){
                        $c->reply("No call with id: $callnr");
                        return;
                }
-               chop($call->{shiptype});
                $callinfo = "(Anti $call->{shiptype} ETA: $call->{eta})";
-               if($call->{covered}){
+               if($call->{status} eq 'Covered'){
                        $c->reply("Call <b>$callnr</b> $callinfo is covered.");
                        return;
                }
        }
-       $c->message("notice $ND::memchan", "DEFENSE REQUIRED!! WAKE UP!!");
-       $c->message("msg $ND::memchan", "DEFENSE REQUIRED $mess $callinfo MSG "
+       $c->message(notice => $ND::memchan, "DEFENSE REQUIRED!! WAKE UP!!");
+       $c->message(privmsg => $ND::memchan, "DEFENSE REQUIRED $mess $callinfo MSG "
                .$c->nick." TO RESPOND");
 }
 
+sub settype
+       : Help(Usage: .settype incId type | or: .settyp callId X:Y:Z type | or: .settypeall callId type)
+       : Type(def)
+       : ACL(irc_settype)
+       : Alias(settypeall)
+{
+       my ($self,$c,$msg) = @_;
+       my $dbh = $c->model;
+
+       my $query = q{
+SELECT inc,call,shiptype, coords(x,y,z),c.landing_tick - tick() AS eta
+FROM incomings i
+       JOIN current_planet_stats p USING (pid)
+       JOIN calls c USING (call)
+       };
+       my $fleets;
+       my $type;
+       my $call;
+
+       if ($self->name eq 'settypeall'){
+               ($call,$type) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
+
+               $fleets = $dbh->prepare($query . q{
+WHERE call = ?
+               });
+               $fleets->execute($call);
+       }else{
+               my ($id,$x,$y,$z,$t) = $msg =~ /^(\d+) (\d+):(\d+):(\d+) (.*)$/;
+               if (defined $id){
+                       $fleets = $dbh->prepare($query . q{
+WHERE call = ? AND pid = planetid(?,?,?,tick())
+                       });
+                       $fleets->execute($id,$x,$y,$z);
+               }else{
+                       ($id,$t) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
+                       $fleets = $dbh->prepare($query . q{
+WHERE inc = ?
+                       });
+                       $fleets->execute($id);
+               }
+               $type = $t;
+       }
+
+       $type = CGI::escapeHTML($type);
+       $dbh->begin_work;
+       my $deflog = '';
+       my $settype = $dbh->prepare(q{UPDATE incomings SET shiptype = ? WHERE inc = ?});
+       while (my $inc = $fleets->fetchrow_hashref){
+               $call //= $inc->{call};
+               if ($inc->{eta} < 0){
+                       $c->reply("This call is old. Did you use the call id instead of inc id by"
+                               ." accident? You can use .settypeall callid to set the type on all incs"
+                               ." in a call. Or use webbie if you really want to update this old call.");
+                       $dbh->rollback;
+                       return;
+               }
+               $settype->execute($type,$inc->{inc});
+               $deflog .= "Set fleet: [B]$inc->{inc} [/B] to: [B]$type [/B]\n";
+               $c->reply("Set fleet $inc->{inc} from $inc->{coords} on call $call to $type (previously $inc->{shiptype})");
+       }
+       if ($fleets->rows == 0){
+               $c->reply("No matching fleets");
+               $dbh->rollback;
+       }else{
+               $c->def_log($call,$deflog);
+               $dbh->commit;
+       }
+}
+
+sub calltake
+       : Help(Usage: .calltake callid | sets the dc. also markes as covered/ignored with .callcov and .callignore)
+       : Type(def)
+       : ACL(irc_calltake)
+       : Alias(qw/callcov callignore/)
+{
+       my ($self,$c,$msg) = @_;
+       my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
+       my $dbh = $c->model;
+
+       my $status = 'Open';
+
+       given ($self->{name}){
+               when('callignore'){
+                       $status = 'Ignored';
+               }
+               when('callcov'){
+                       $status = 'Covered';
+               }
+       }
+
+       $dbh->begin_work;
+       my $rows = $dbh->do(q{
+UPDATE calls SET dc = (SELECT uid FROM users WHERE hostmask ILIKE $1)
+       ,status = $3
+WHERE call = $2
+               },undef,$c->host,$id,$status);
+       if ($rows == 1){
+               $c->reply("Setting status on call $id to $status");
+               $c->def_log($id , "Changed status: [B]$status [/B]");
+               $dbh->commit;
+       }else{
+               $c->reply("$id is not a valid call");
+               $dbh->rollback;
+       }
+}
+
+sub setcalc
+       : Help(Usage: .setcalc callId calc | sets the calc for the given call.)
+       : Type(def)
+       : ACL(irc_setcalc)
+{
+       my ($self,$c,$msg) = @_;
+       my ($id,$calc) = $msg =~ /^(\d+) (.+)$/ or die 'ARGS';
+       my $dbh = $c->model;
+
+       $dbh->begin_work;
+       my $rows = $dbh->do(q{UPDATE calls SET calc = $2 WHERE id = $1}
+               ,undef,$id, $calc);
+       if ($rows == 1){
+               $c->reply("Updated calc call <b>$id</b>");
+               $calc = CGI::escapeHTML($calc);
+               $c->def_log($id , 'Updated calc to: [URL]'.$calc.'[/URL]');
+               $dbh->commit;
+       }else{
+               $c->reply("$id is not a valid call");
+               $dbh->rollback;
+       }
+}
+
+sub getcalc
+       : Help(Usage: .getcalc callId | receives the calc for the given call)
+       : Type(def)
+       : ACL(irc_getcalc)
+{
+       my ($self,$c,$msg) = @_;
+       my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
+       my $dbh = $c->model;
+
+       my $calc = $dbh->selectrow_array(q{
+SELECT calc FROM calls WHERE id = $1}
+               ,undef,$id);
+       $calc //= "Bad call id, there is no such call.";
+       $c->reply("Calc for call <b>$id</b>: $calc");
+}
+
+
 1;