From f2538e3c6d6f4f7a9fd9b349787d4caff8c12910 Mon Sep 17 00:00:00 2001 From: Michael Andreen Date: Sun, 6 Dec 2009 00:02:57 +0100 Subject: [PATCH] Converted Def --- Commands/Def.pm | 336 ++++++++++++++++++++++++------------------------ 1 file changed, 170 insertions(+), 166 deletions(-) diff --git a/Commands/Def.pm b/Commands/Def.pm index c49405c..d16de2d 100644 --- a/Commands/Def.pm +++ b/Commands/Def.pm @@ -17,43 +17,40 @@ # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * #**************************************************************************/ -package NDIRC::Commands::Def; - 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, "$mess"); - $c->message(privmsg => $c->channel, "$target << $mess"); -} + $c->message(privmsg => $target, "$mess"); + $c->message(privmsg => $c->channel, "$target << $mess"); + } +}; -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 @@ -63,176 +60,184 @@ FROM calls c 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 $callnr $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 $callnr $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) - }; - 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{ -WHERE call = ? AND pid = planetid(?,?,?,tick()) - }); - $fleets->execute($id,$x,$y,$z); +WHERE call = ? + }); + $fleets->execute($call); }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 = ? - }); - $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; - 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 - },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 $id"); - $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 $id"); + $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} - ,undef,$id); - $calc //= "Bad call id, there is no such call."; - $c->reply("Calc for call $id: $calc"); -} + ,undef,$id); + $calc //= "Bad call id, there is no such call."; + $c->reply("Calc for call $id: $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; { @@ -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); - @attacker = map (valuecolor(0),@attacker); + @attacker = map ($c->valuecolor(0),@attacker); if (! $threefleeter || $call[1] ne 'Ignored'){ $c->reply("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]"); }else{ @@ -300,7 +305,7 @@ INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING in $c->reply("Call is likely not covered anymore, please recalc! calc: $call[2]"); } }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"); } @@ -319,8 +324,7 @@ SELECT count(*) FROM launch_confirmations WHERE uid = ? AND back = ? $c->reply("No member registered with coordinates $1:$2:$3"); } } - -} +}; 1; -- 2.39.2