Converted Def

diff --git a/Commands/Def.pm b/Commands/Def.pm
index c49405c96b5b8bf140bbc840fe47b4cc72422075..d16de2d5ffc72cd261ebbf3bd4a0846f26d62a42 100644 (file)
--- a/Commands/Def.pm
+++ b/Commands/Def.pm
@@ -17,43 +17,40 @@
 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
 #**************************************************************************/
 
 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
 #**************************************************************************/
 

-package NDIRC::Commands::Def;
-

 use strict;
 use warnings;
 use feature ':5.10';
 
 use strict;
 use warnings;
 use feature ':5.10';
 

-use CGI;

 
 

-use Moose;
-use MooseX::MethodAttributes;
-use NDIRC::Misc;
+use MooseX::Declare;
+use NDIRC::Dispatcher;

 
 

-sub anon
-       : Help(syntax: .anon nick message)
-       : Type(def)
-       : ACL(irc_anondef)
-{
-       my ($self,$c,$msg) = @_;
+command anon => {
+       help => q(syntax: .anon nick message),
+       type => q(def),
+       acl => q(irc_anondef),
+}, class extends NDIRC::Command {
+       method execute($c,$msg) {

 
 

-       my ($target,$mess) = $msg =~ /^(\S+) (.*)$/ or die 'ARGS';
+               my ($target,$mess) = $msg =~ /^(\S+) (.*)$/ or die 'ARGS';

 
 

-       $c->message(privmsg => $target, "<b>$mess</b>");
-       $c->message(privmsg => $c->channel, "<c03>$target << $mess</c>");
-}
+               $c->message(privmsg => $target, "<b>$mess</b>");
+               $c->message(privmsg => $c->channel, "<c03>$target << $mess</c>");
+       }
+};

 
 

-sub defcall
-       : Help(syntax: .defcall [callid] | if a call id is given, then shiptypes and eta will be fetched from the database and added to the message)
-       : Type(def)
-       : ACL(irc_defcall)
-{
-       my ($self,$c,$msg) = @_;
-       my ($callnr,$mess) = $msg =~ /^(\d+)?(.*)$/ or die 'ARGS';
-       my $dbh = $c->model;
+command defcall => {
+       help => q(syntax: .defcall [callid] | if a call id is given, then shiptypes and eta will be fetched from the database and added to the message),
+       type => q(def),
+       acl => q(irc_defcall),
+}, class extends NDIRC::Command {
+       method execute($c,$msg) {
+               my ($callnr,$mess) = $msg =~ /^(\d+)?(.*)$/ or die 'ARGS';
+               my $dbh = $c->model;

 
 

-       my $callinfo = "";
-       if ($callnr){
-               my $st = $dbh->prepare(q{
+               my $callinfo = "";
+               if ($callnr){
+                       my $st = $dbh->prepare(q{

 SELECT status
        ,c.landing_tick - (SELECT value::integer FROM misc WHERE id = 'TICK') AS eta
        ,array_to_string(array_agg(i.shiptype),'/') AS shiptype
 SELECT status
        ,c.landing_tick - (SELECT value::integer FROM misc WHERE id = 'TICK') AS eta
        ,array_to_string(array_agg(i.shiptype),'/') AS shiptype


@@ -63,176 +60,184 @@ FROM calls c
 WHERE c.call = ?
 GROUP BY c.call,c.landing_tick,c.status
 ORDER BY c.landing_tick;
 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->{status}){
-                       $c->reply("No call with id: $callnr");
-                       return;
-               }
-               $callinfo = "(Anti $call->{shiptype} ETA: $call->{eta})";
-               if($call->{status} eq 'Covered'){
-                       $c->reply("Call <b>$callnr</b> $callinfo is covered.");
-                       return;
+                               });
+                       my $call = $dbh->selectrow_hashref($st,undef,$callnr);
+                       unless (defined $call->{status}){
+                               $c->reply("No call with id: $callnr");
+                               return;
+                       }
+                       $callinfo = "(Anti $call->{shiptype} ETA: $call->{eta})";
+                       if($call->{status} eq 'Covered'){
+                               $c->reply("Call <b>$callnr</b> $callinfo is covered.");
+                               return;
+                       }

                }
                }

+               $c->message(notice => $c->disp->targets->{members}, "DEFENSE REQUIRED!! WAKE UP!!");
+               $c->message(privmsg => $c->disp->targets->{members}, "DEFENSE REQUIRED "
+                       ."$mess $callinfo MSG ".$c->nick." TO RESPOND");

        }
        }

-       $c->message(notice => $c->disp->targets->{members}, "DEFENSE REQUIRED!! WAKE UP!!");
-       $c->message(privmsg => $c->disp->targets->{members}, "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;
+command settype => {
+       help => q(Usage: .settype incId type | or: .settyp callId X:Y:Z type | or: .settypeall callId type),
+       type => q(def),
+       acl => q(irc_settype),
+       alias => q(settypeall),
+}, class extends NDIRC::Command {
+       use CGI;
+       method execute($c,$msg) {
+               my $dbh = $c->model;

 
 

-       my $query = q{
+               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)
 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;
+               };
+               my $fleets;
+               my $type;
+               my $call;

 
 

-       if ($self->name eq 'settypeall'){
-               ($call,$type) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
+               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{
                        $fleets = $dbh->prepare($query . q{

-WHERE call = ? AND pid = planetid(?,?,?,tick())
-                       });
-                       $fleets->execute($id,$x,$y,$z);
+WHERE call = ?
+                               });
+                       $fleets->execute($call);

                }else{
                }else{

-                       ($id,$t) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
-                       $fleets = $dbh->prepare($query . q{
+                       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 = ?
 WHERE inc = ?

-                       });
-                       $fleets->execute($id);
+                                       });
+                               $fleets->execute($id);
+                       }
+                       $type = $t;

                }
                }

-               $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.");
+               $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;
                        $dbh->rollback;

-                       return;
+               }else{
+                       $c->def_log($call,$deflog);
+                       $dbh->commit;

                }
                }

-               $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;
+command calltake => {
+       help => q(Usage: .calltake callid | sets the dc. also markes as covered/ignored with .callcov and .callignore),
+       type => q(def),
+       acl => q(irc_calltake),
+       alias => [qw/callcov callignore/],
+}, class extends NDIRC::Command {
+       method execute($c,$msg) {
+               my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
+               my $dbh = $c->model;

 
 

-       my $status = 'Open';
+               my $status = 'Open';

 
 

-       given ($self->{name}){
-               when('callignore'){
-                       $status = 'Ignored';
-               }
-               when('callcov'){
-                       $status = 'Covered';
+               given ($self->{name}){
+                       when('callignore'){
+                               $status = 'Ignored';
+                       }
+                       when('callcov'){
+                               $status = 'Covered';
+                       }

                }
                }

-       }

 
 

-       $dbh->begin_work;
-       my $rows = $dbh->do(q{
+               $dbh->begin_work;
+               my $rows = $dbh->do(q{

 UPDATE calls SET dc = $1
        ,status = $3
 WHERE call = $2
 UPDATE calls SET dc = $1
        ,status = $3
 WHERE call = $2

-               },undef,$c->uid,$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;
+                       },undef,$c->uid,$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;
+command setcalc => {
+       help => q(Usage: .setcalc callId calc | sets the calc for the given call.),
+       type => q(def),
+       acl => q(irc_setcalc),
+}, class extends NDIRC::Command {
+       use CGI;
+       method execute($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 call = $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;
+               $dbh->begin_work;
+               my $rows = $dbh->do(q{UPDATE calls SET calc = $2 WHERE call = $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;
+command getcalc => {
+       help => q(Usage: .getcalc callId | receives the calc for the given call),
+       type => q(def),
+       acl => q(irc_getcalc),
+}, class extends NDIRC::Command {
+       method execute($c,$msg) {
+               my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
+               my $dbh = $c->model;

 
 

-       my $calc = $dbh->selectrow_array(q{
+               my $calc = $dbh->selectrow_array(q{

 SELECT calc FROM calls WHERE call = $1}
 SELECT calc FROM calls WHERE call = $1}

-               ,undef,$id);
-       $calc //= "Bad call id, there is no such call.";
-       $c->reply("Calc for call <b>$id</b>: $calc");
-}
+                       ,undef,$id);
+               $calc //= "Bad call id, there is no such call.";
+               $c->reply("Calc for call <b>$id</b>: $calc");
+       }
+};

 
 

-sub report_incs
-       : Help(Used to report incs, same as pasting in pm. Use ~ prefix to send output to channel)
-       : Type(def)
-{
-       my ($self,$c,$msg) = @_;
+command report_incs => {
+       help => q(Used to report incs, same as pasting in pm. Use ~ prefix to send output to channel),
+       type => q(def),
+}, class extends NDIRC::Command {
+       method execute($c,$msg) {

 
 

-       if ($msg =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\s+(\d+)/
-                       || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/){
+               $msg =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\s+(\d+)/
+               || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/
+                       or return;

                my $dbh = $c->model;
                my $amount = $8;
                {
                my $dbh = $c->model;
                my $amount = $8;
                {


@@ -288,7 +293,7 @@ INSERT INTO calls (uid,landing_tick,info) VALUES(?,?,'') RETURNING call,status,c
                                                my $incid = $dbh->selectrow_array(q{
 INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING inc
                                                },undef,$call[0],$attacker[2],$9,$amount,$7);
                                                my $incid = $dbh->selectrow_array(q{
 INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING inc
                                                },undef,$call[0],$attacker[2],$9,$amount,$7);

-                                               @attacker = map (valuecolor(0),@attacker);
+                                               @attacker = map ($c->valuecolor(0),@attacker);

                                                if (! $threefleeter || $call[1] ne 'Ignored'){
                                                        $c->reply("<b>New incoming: CallId: $call[0], IncId: $incid $1:$2:$3 ($user->{defprio}) is under Attack by $4:$5:$6, ($attacker[3]), $attacker[1]($attacker[4]) https://nd.ruin.nu/calls/edit/$call[0]</b>");
                                                }else{
                                                if (! $threefleeter || $call[1] ne 'Ignored'){
                                                        $c->reply("<b>New incoming: CallId: $call[0], IncId: $incid $1:$2:$3 ($user->{defprio}) is under Attack by $4:$5:$6, ($attacker[3]), $attacker[1]($attacker[4]) https://nd.ruin.nu/calls/edit/$call[0]</b>");
                                                }else{


@@ -300,7 +305,7 @@ INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING in
                                                        $c->reply("<b>Call is likely not covered anymore, please recalc! calc: $call[2]</b>");
                                                }
                                        }else{
                                                        $c->reply("<b>Call is likely not covered anymore, please recalc! calc: $call[2]</b>");
                                                }
                                        }else{

-                                               @attacker = map (valuecolor(0),@attacker);
+                                               @attacker = map ($c->valuecolor(0),@attacker);

                                                $c->reply("Duplicate call: Callid: $call[0], Status: $call[1] $1:$2:$3 ($user->{defprio}) is under Attack by $4:$5:$6, ($attacker[3]), $attacker[1]($attacker[4]), landing tick: $landing_tick");
                                        }
 
                                                $c->reply("Duplicate call: Callid: $call[0], Status: $call[1] $1:$2:$3 ($user->{defprio}) is under Attack by $4:$5:$6, ($attacker[3]), $attacker[1]($attacker[4]), landing tick: $landing_tick");
                                        }
 


@@ -319,8 +324,7 @@ SELECT count(*) FROM launch_confirmations WHERE uid = ? AND back = ?
                        $c->reply("<c04>No member registered with coordinates $1:$2:$3</c>");
                }
        }
                        $c->reply("<c04>No member registered with coordinates $1:$2:$3</c>");
                }
        }

-
-}
+};

 
 1;
 
 
 1;