Commands/PA.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2008 by Michael Andreen <harvATruinDOTnu>               *
   3 #                                                                         *
   4 #   This program is free software; you can redistribute it and/or modify  *
   5 #   it under the terms of the GNU General Public License as published by  *
   6 #   the Free Software Foundation; either version 2 of the License, or     *
   7 #   (at your option) any later version.                                   *
   8 #                                                                         *
   9 #   This program is distributed in the hope that it will be useful,       *
  10 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  11 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  12 #   GNU General Public License for more details.                          *
  13 #                                                                         *
  14 #   You should have received a copy of the GNU General Public License     *
  15 #   along with this program; if not, write to the                         *
  16 #   Free Software Foundation, Inc.,                                       *
  17 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  18 #**************************************************************************/
  19
  20 package NDIRC::Commands::PA;
  21
  22 use strict;
  23 use warnings;
  24 use feature ':5.10';
  25
  26 use Moose;
  27 use MooseX::MethodAttributes;
  28
  29 use NDIRC::Misc;
  30 use ND::Include;
  31
  32 sub p
  33         : Help(usage: .p X:Y:Z | or .p nick with high enough access)
  34 {
  35         my ($self, $c, $msg) = @_;
  36
  37         my ($x,$y,$z,$nick);
  38         if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){
  39                 $x = $1;
  40                 $y = $2;
  41                 $z = $3;
  42         }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){
  43                 $nick = $msg;
  44         }else{
  45                 die "ARGS";
  46         }
  47
  48         my $f = $c->model->prepare(q{
  49 SELECT coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
  50         valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
  51 FROM current_planet_stats WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
  52         });
  53         $f->execute($x,$y,$z,$nick);
  54         if (my $planet = $f->fetchrow_hashref()){
  55                 for (keys %{$planet}){
  56                         $planet->{$_} = valuecolor(1,$planet->{$_});
  57                 }
  58                 my $ally = "";
  59                 if ($c->check_user_roles(qw/irc_p_intel/)){
  60                         $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
  61                 }
  62                 $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})");
  63         }else{
  64                 $c->reply("Couldn't find planet: $msg");
  65         }
  66 }
  67
  68 sub g
  69         : Help(usage: .g X:Y)
  70 {
  71         my ($self, $c, $msg) = @_;
  72
  73         my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS';
  74
  75         my $f = $c->model->prepare(q{
  76 SELECT score,scorerank,size,sizerank,value,valuerank,planets
  77 FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
  78         });
  79         $f->execute($x,$y);
  80         while (my @row = $f->fetchrow()){
  81                 @row = map (valuecolor(1),@row);
  82                 $c->reply("$x:$y  Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6]");
  83         }
  84 }
  85
  86 sub time
  87         : 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.)
  88 {
  89         my ($self, $c, $msg) = @_;
  90         my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS';
  91
  92         eval {
  93                 $tick //= $c->model->selectrow_array(q{SELECT tick()});
  94                 $timezone //= 'GMT';
  95                 my $query = $c->model->prepare(q{
  96 SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME ZONE $2
  97                         });
  98                 $query->execute($tick,$timezone);
  99                 my $time = $query->fetchrow_array;
 100                 $c->reply("Time at tick <b>$tick</b>, timezone <b>$timezone</b>: <b>$time</b>");
 101         };
 102         given ($@){
 103                 when(/time zone "(.+?)" not recognized/){
 104                         $c->reply("<c04>$1</c> is not a valid timezone.");
 105                 }
 106                 die $@ if $@;
 107         }
 108 }
 109
 110 sub xp
 111         : 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 0.25)
 112 {
 113         my ($self, $c, $msg) = @_;
 114
 115         my ($x,$y,$z,$roids,$cap) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)(?:[^\.\d]+(\d+))?(?:[^\.\d]+(\d*\.\d+))?$/
 116                 or die 'ARGS';
 117
 118         my ($avalue,$ascore) = $c->model->selectrow_array(q{
 119 SELECT value,score FROM current_planet_stats
 120 WHERE id = (SELECT planet FROM users WHERE hostmask ILIKE ?)
 121                 }, undef, $c->host);
 122         my ($tvalue,$tscore,$tsize) = $c->model->selectrow_array(q{
 123 SELECT value,score,size FROM current_planet_stats
 124 WHERE x = ? AND y = ? and z = ?
 125                 }, undef, $x,$y,$z);
 126         $cap //= 0.25;
 127         unless($roids){
 128                 $roids = int($tsize*$cap);
 129         }elsif ($roids < 10){
 130                 $tsize = ceil($tsize*.75**($roids-1));
 131                 $roids = int($cap*$tsize);
 132         }
 133         $tsize -= $roids;
 134         unless (defined $avalue && defined $ascore){
 135                 $c->reply("You don't have a planet specified");
 136                 return;
 137         }
 138         unless (defined $tvalue && defined $tscore){
 139                 $c->reply("No planet found at $x:$y:$z");
 140                 return;
 141         }
 142         my $xp = pa_xp($roids,$ascore,$avalue,$tscore,$tvalue);
 143         my $score = 60 * $xp;
 144         my $value = $roids*200;
 145         my $totscore = prettyValue($score + $value);
 146         $c->reply("You will gain <b>$xp</b> XP, <b>$score</b> score, if you steal $roids roids (<b>$value</b> value), from <b>$x:$y:$z</b>, who will have <b>$tsize</b> roids left, total score gain will be: <b>$totscore</b> in total,");
 147 }
 148
 149 1;