From 82565659237ad7e2d279a19bac94d5d6a9335478 Mon Sep 17 00:00:00 2001 From: Michael Andreen Date: Sat, 5 Dec 2009 13:41:54 +0100 Subject: [PATCH] Converted PA --- Commands/PA.pm | 379 ++++++++++++++++++++++++++----------------------- Context.pm | 12 ++ Misc.pm | 44 ------ 3 files changed, 217 insertions(+), 218 deletions(-) delete mode 100644 Misc.pm diff --git a/Commands/PA.pm b/Commands/PA.pm index 1db6ac1..8a40007 100644 --- a/Commands/PA.pm +++ b/Commands/PA.pm @@ -17,44 +17,38 @@ # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * #**************************************************************************/ -package NDIRC::Commands::PA; - use strict; use warnings; use feature ':5.10'; -use Moose; -use MooseX::MethodAttributes; -use POSIX qw/pow/; - -use NDIRC::Misc; -use ND::Include; - - -sub bcalc - : Help(Lists bcalc and stats info) -{ - my ($self, $c, $msg) = @_; - $c->reply("http://game.planetarion.com/bcalc.pl http://game.planetarion.com/manual.php?page=stats"); -} - -sub p - : Help(usage: .p X:Y:Z | or .p nick with high enough access) -{ - my ($self, $c, $msg) = @_; - - my ($x,$y,$z,$nick); - if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){ - $x = $1; - $y = $2; - $z = $3; - }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){ - $nick = $msg; - }else{ - die "ARGS"; +use MooseX::Declare; +use NDIRC::Dispatcher; + +command bcalc => { + help => q(Lists bcalc and stats info), +}, class extends NDIRC::Command { + method execute($c,$msg) { + $c->reply("http://game.planetarion.com/bcalc.pl http://game.planetarion.com/manual.php?page=stats"); } +}; - my $f = $c->model->prepare(q{ +command p => { + help => q(usage: .p X:Y:Z | or .p nick with high enough access), +}, class extends NDIRC::Command { + method execute($c,$msg) { + + my ($x,$y,$z,$nick); + if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){ + $x = $1; + $y = $2; + $z = $3; + }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){ + $nick = $msg; + }else{ + die "ARGS"; + } + + my $f = $c->model->prepare(q{ WITH p AS (SELECT pid,coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank, valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel FROM current_planet_stats @@ -69,61 +63,63 @@ WITH p AS (SELECT pid,coords(x,y,z),ruler,planet,race,score,size,value,scorerank FROM t ) SELECT * FROM p, tags; - }); - $f->execute($x,$y,$z,$nick,$c->uid,$c->check_user_roles(qw/irc_p_intel/) // 0); - if (my $planet = $f->fetchrow_hashref()){ - for (keys %{$planet}){ - $planet->{$_} = valuecolor(1,$planet->{$_}); - } - my $ally = ""; - if ($c->check_user_roles(qw/irc_p_intel/)){ - $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},"; + }); + $f->execute($x,$y,$z,$nick,$c->uid,$c->check_user_roles(qw/irc_p_intel/) // 0); + if (my $planet = $f->fetchrow_hashref()){ + for (keys %{$planet}){ + $planet->{$_} = $c->valuecolor(1,$planet->{$_}); + } + my $ally = ""; + if ($c->check_user_roles(qw/irc_p_intel/)){ + $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},"; + } + $c->reply("$planet->{coords} $planet->{ruler} OF $planet->{planet},$ally Race=$planet->{race}, Score=$planet->{score} ($planet->{scorerank}), Size=$planet->{size} ($planet->{sizerank}), Value=$planet->{value} ($planet->{valuerank}), XP=$planet->{xp} ($planet->{xprank}) TAGS: $planet->{tags}"); + }else{ + $c->reply("Couldn't find planet: $msg"); } - $c->reply("$planet->{coords} $planet->{ruler} OF $planet->{planet},$ally Race=$planet->{race}, Score=$planet->{score} ($planet->{scorerank}), Size=$planet->{size} ($planet->{sizerank}), Value=$planet->{value} ($planet->{valuerank}), XP=$planet->{xp} ($planet->{xprank}) TAGS: $planet->{tags}"); - }else{ - $c->reply("Couldn't find planet: $msg"); } -} +}; -sub g - : Help(usage: .g X:Y) -{ - my ($self, $c, $msg) = @_; +command g => { + help => q(usage: .g X:Y), +}, class extends NDIRC::Command { + method execute($c,$msg) { - my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS'; - my $dbh = $c->model; + my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS'; + my $dbh = $c->model; - my $f = $dbh->prepare(q{ -SELECT score,scorerank,size,sizerank,value,valuerank,planets -FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies) - }); - $f->execute($x,$y); - my @row = $f->fetchrow; - unless (@row){ - $c->reply("No planet at $x:$y"); - return; - } - my @planets; - if ($c->check_user_roles(qw/irc_g_intel/)) { - my $query = $dbh->prepare(q{ + my $f = $dbh->prepare(q{ + SELECT score,scorerank,size,sizerank,value,valuerank,planets + FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies) + }); + $f->execute($x,$y); + my @row = $f->fetchrow; + unless (@row){ + $c->reply("No galaxy at $x:$y"); + return; + } + my @planets; + if ($c->check_user_roles(qw/irc_g_intel/)) { + my $query = $dbh->prepare(q{ SELECT z,COALESCE(nick,'?') AS nick,COALESCE(alliance,'?') AS alliance FROM current_planet_stats WHERE x = $1 AND y = $2 ORDER BY z - }); - $query->execute($x,$y); - while(my $p = $query->fetchrow_hashref){ - push @planets, "$p->{z} [$p->{nick}/$p->{alliance}]"; + }); + $query->execute($x,$y); + while(my $p = $query->fetchrow_hashref){ + push @planets, "$p->{z} [$p->{nick}/$p->{alliance}]"; + } } + @row = map ($c->valuecolor(1),@row); + $c->reply("$x:$y Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6] - " + . join " ", @planets); } - @row = map (valuecolor(1),@row); - $c->reply("$x:$y Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6] - " - . join " ", @planets); -} - -sub time - : Help(syntax: .time [tick] [timezone] | Gives the time at the specied tick. Assumes GMT if no timezone is given and current tick if no tick is given.) -{ - my ($self, $c, $msg) = @_; +}; + +command time => { + help => q(syntax: .time [tick] [timezone] | Gives the time at the specied tick. Assumes GMT if no timezone is given and current tick if no tick is given.), +}, class extends NDIRC::Command { + method execute($c,$msg) { my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS'; eval { @@ -142,12 +138,15 @@ SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME } die $@ if $@; } -} + } +}; -sub xp - : Help(syntax: .xp X:Y:Z [roids] [cap] | if roids < 10 then it's taken as the wave, cap is a floating point number, defaults to cap according to your value) -{ - my ($self, $c, $msg) = @_; +command xp => { + help => q(syntax: .xp X:Y:Z [roids] [cap] | if roids < 10 then it's taken as the wave, cap is a floating point number, defaults to cap according to your value), +}, class extends NDIRC::Command { + use POSIX qw/pow/; + use ND::Include; + method execute($c,$msg) { my ($x,$y,$z,$roids,$cap) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/ or die 'ARGS'; @@ -182,12 +181,13 @@ WHERE x = ? AND y = ? and z = ? my $totscore = prettyValue($score + $value); $cap = sprintf "%.1f", $cap*100; $c->reply("You will gain $xp XP, $score score, if you steal $roids roids ($value value, $cap% cap), from $x:$y:$z, who will have $tsize roids left, total score gain will be: $totscore in total,"); -} + } +}; -sub fco - : Help(syntax: .fco agents stolen [tick] | tick can be omitted if you're doing this the same tick you got cov opped, if you have different amount of your resources stolen, specify the highest amount. Only works if less than 10% of your resources and < 10,000*agents were stolen) -{ - my ($self, $c, $msg) = @_; +command fco => { + help => q(syntax: .fco agents stolen [tick] | tick can be omitted if you're doing this the same tick you got cov opped, if you have different amount of your resources stolen, specify the highest amount. Only works if less than 10% of your resources and < 10,000*agents were stolen), +}, class extends NDIRC::Command { + method execute($c,$msg) { my ($agents,$stolen,$tick) = $msg =~ /^(\d+)\s+(\d+)\s*(\d+)?$/ or die 'ARGS'; @@ -216,76 +216,55 @@ WHERE ps.tick = $1 AND trunc(2000.0*$2*$3/ps.value)::int = $4 } $c->reply("The planet that cov opped you is one of: $coords"); } -} - -sub eff - : Alias(qw/veff stop vstop/) - : Help( syntax: .eff amount ship [race|class] | Amount can use SI prefixes like k and M. Race or class is an optional argument, using the short form (i.e. cath or Fi) | veff, stop and vstop are variations of this command) -{ - my ($self, $c, $msg) = @_; - my ($amount,$ship,$target) = $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/ - or die 'ARGS'; - - my $eff = ($self->name =~ /(eff)/); - $ship = "\%$ship\%"; - $target //= '%'; - my $value; - if ($self->name =~ /^v.+$/){ - $value = parseValue($amount); - $value *= -1.5 if $value < 0; - }else{ - $amount = parseValue($amount); } +}; + +my $eff = class extends NDIRC::Command { + use ND::Include; + method execute($c,$msg) { + my ($amount,$ship,$target) = $msg =~ /^(-?\d+(?:\.\d+)?[hkMG]?) (\w+)(?: (\w+))?/ + or die 'ARGS'; + + $ship = "\%$ship\%"; + $target //= '%'; + my $value; + if ($self->name =~ /^v.+$/){ + $value = parseValue($amount); + $value *= -1.5 if $value < 0; + }else{ + $amount = parseValue($amount); + } + + my $feud = ''; + + my $s= $c->model->selectrow_hashref(q{ +SELECT name,t1,t2,t3,"type",damage + ,metal+crystal+eonium AS cost + ,init,"class",guns,race,eres,armor +FROM ship_stats WHERE name ILIKE ? + }, undef, $ship); - my $feud = ''; + return unless $s; - my $s= $c->model->selectrow_hashref(q{ - SELECT name,t1,t2,t3,"type",damage - ,metal+crystal+eonium AS cost - ,init,"class",guns,race,eres,armor - FROM ship_stats WHERE name ILIKE ? - }, undef, $ship); - if ($s){ if (defined $value){ $amount = int(($value*100/$s->{cost})); $feud = '(FEUD: '.prettyValue(int($amount/0.86)).') '; } $value = prettyValue(($amount*$s->{cost}/100)); my $name = shipColor($s->{name},$s->{type}); - my $text = prettyValue($amount)." $name ($s->{init}:$value) :"; + my $text = prettyValue($amount)." $feud $name ($s->{init}:$value) :"; for my $tn ('t1','t2','t3'){ - next if ($eff && not defined $s->{$tn}); - $text .= " " . ($eff ? $s->{$tn} : $tn) . ": "; - my $st = q{ - SELECT name,"class","type",armor - ,metal+crystal+eonium AS cost - ,init,t1,t2,t3,eres,race - ,damage,guns - FROM ship_stats - }; - if ($eff){ - $st = $c->model->prepare($st . q{ - WHERE "class" = $1 - AND ("class" ILIKE $2 OR race ILIKE $2) - }); - $st->execute($s->{$tn},$target); - }else{ - $st = $c->model->prepare($st . qq{ - WHERE $tn = \$1 - AND ("class" ILIKE \$2 OR race ILIKE \$2) - }); - $st->execute($s->{class},$target); - } + next unless defined ($self->target($s,$tn)); + $text .= " " . $self->target($s,$tn) . ": "; + my $st = $self->query(q{ +SELECT name,"class","type",armor + ,metal+crystal+eonium AS cost + ,init,t1,t2,t3,eres,race + ,damage,guns +FROM ship_stats + },$c,$s,$tn,$target); while (my $t = $st->fetchrow_hashref()){ - my $number = calcEff($s,$t,$amount,$eff); - if ($eff){ - $number *= 0.60 if $tn eq 't2'; - $number *= 0.30 if $tn eq 't3'; - }else{ - $number /= 0.60 if $tn eq 't2'; - $number /= 0.30 if $tn eq 't3'; - } - $number = int($number); + my $number = $self->calcEff($s,$t,$tn,$amount); $value = prettyValue($number*$t->{cost}/100); my $name = shipColor($t->{name},$t->{type}); $text .= " $number $name ($t->{init}:$value),"; @@ -294,42 +273,94 @@ sub eff } $c->reply($text); } -} -sub calcEff { - my ($s,$t,$amount,$eff) = @_; + method calcEff ($s,$t,$tn,$amount) { + my $number = int($self->amount($s,$t,$tn,$amount)); - my $number = 0; - if ($eff){ - $number = $s->{type} eq 'Emp' ? + for my $tn ('t1','t2','t3'){ + my ($s1,$t1) = $self->shipOrder($s,$t); + next unless (defined $t1->{$tn}); + next unless ($t1->{$tn} eq $s1->{class}); + + if($t1->{init} <= $s1->{init}){ + $t->{init} = "$t->{init}"; + }else{ + $t->{init} = "$t->{init}"; + } + } + return $number; + } + + sub shipColor { + my ($string,$type) = @_; + my $c = 04; + $c = 12 if $type eq 'Emp'; + $c = 13 if $type eq 'Steal'; + return "$string"; + } + + method amount ($s,$t,$tn,$amount) { + my $number = $s->{type} eq 'Emp' ? ($amount*$s->{guns}*(100-$t->{eres})/100) : ($amount*$s->{damage}/$t->{armor}); - }else{ - $number = $t->{type} eq 'Emp' ? - ($amount*100/(100 - $s->{eres})/$t->{guns}) - : ($amount*$s->{armor}/$t->{damage}); + $number *= 0.60 if $tn eq 't2'; + $number *= 0.30 if $tn eq 't3'; + return $number; } - for my $tn ('t1','t2','t3'){ - my ($s1,$t1) = $eff ? ($s,$t) : ($t,$s); - next unless (defined $t1->{$tn}); - next unless ($t1->{$tn} eq $s1->{class}); + method target ($s,$tn) { + return $s->{$tn}; + } - if($t1->{init} <= $s1->{init}){ - $t->{init} = "$t->{init}"; - }else{ - $t->{init} = "$t->{init}"; - } + method query ($st,$c,$s,$tn,$target) { + $st = $c->model->prepare($st . q{ + WHERE "class" = $1 + AND ("class" ILIKE $2 OR race ILIKE $2) + }); + $st->execute($s->{$tn},$target); + return $st; + } + + method shipOrder ($s,$t) { + return ($s,$t); + } +}; + +command eff => { + alias => q/veff/, + help => q( syntax: .[v]eff amount ship [race|class] | Amount can use SI prefixes like k and M. Race or class is an optional argument, using the short form (i.e. Ter or Fi) | veff uses value instead of amount), +}, $eff; + +command stop => { + alias => q/vstop/, + help => q( syntax: .[v]stop amount ship [race|class] | Amount can use SI prefixes like k and M. Race or class is an optional argument, using the short form (i.e. Ter or Fi) | vstop uses value instead of amount), +}, class { + extends $eff->name; + + method target ($s,$tn){ + return $tn; + } + + method query ($st,$c,$s,$tn,$target) { + $st = $c->model->prepare($st . qq{ + WHERE $tn = \$1 + AND ("class" ILIKE \$2 OR race ILIKE \$2) + }); + $st->execute($s->{class},$target); + return $st; } - return $number; -} -sub shipColor { - my ($string,$type) = @_; - my $c = 04; - $c = 12 if $type eq 'Emp'; - $c = 13 if $type eq 'Steal'; - return "$string"; -} + method amount ($s,$t,$tn,$amount) { + my $number = $t->{type} eq 'Emp' ? + ($amount*100/(100 - $s->{eres})/$t->{guns}) + : ($amount*$s->{armor}/$t->{damage}); + $number /= 0.60 if $tn eq 't2'; + $number /= 0.30 if $tn eq 't3'; + return $number; + } + method shipOrder ($s,$t) { + return ($t,$s); + } +}; 1; diff --git a/Context.pm b/Context.pm index 8c16a95..5810ca4 100644 --- a/Context.pm +++ b/Context.pm @@ -196,4 +196,16 @@ WHERE hostmask = $1 return -4; } +sub valuecolor { + shift @_; + my $s = $_; + $s = $_[1] if $#_ >= 1; + $s = "" unless defined $s; + return "$s" if $s eq 'Hostile'; + return "$s" if $s eq 'Friendly'; + return "$s" if $s eq 'Nap' or $s eq 'NAP'; + return "$s" if $_[0]; + return $s; +} + 1; diff --git a/Misc.pm b/Misc.pm deleted file mode 100644 index aad40e3..0000000 --- a/Misc.pm +++ /dev/null @@ -1,44 +0,0 @@ -#************************************************************************** -# Copyright (C) 2006 by Michael Andreen * -# * -# This program is free software; you can redistribute it and/or modify * -# it under the terms of the GNU General Public License as published by * -# the Free Software Foundation; either version 2 of the License, or * -# (at your option) any later version. * -# * -# This program is distributed in the hope that it will be useful, * -# but WITHOUT ANY WARRANTY; without even the implied warranty of * -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * -# GNU General Public License for more details. * -# * -# You should have received a copy of the GNU General Public License * -# along with this program; if not, write to the * -# Free Software Foundation, Inc., * -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * -#**************************************************************************/ -package NDIRC::Misc; -use strict; -use warnings; -use feature ':5.10'; - -require Exporter; - -use NDIRC::Context; - -our @ISA = qw/Exporter/; - -our @EXPORT = qw/valuecolor/; - -sub valuecolor { - my $s = $_; - $s = $_[1] if $#_ >= 1; - $s = "" unless defined $s; - return chr(3)."5$s".chr(15) if $s eq 'Hostile'; - return chr(3)."3$s".chr(15) if $s eq 'Friendly'; - return chr(3)."3$s".chr(15) if $s eq 'Nap' or $s eq 'NAP'; - return chr(2)."$s".chr(15) if $_[0]; - return $s; -} - - -1; -- 2.39.2