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
  31 sub p
  32         : Help(usage: .p X:Y:Z | or .p nick with high enough access)
  33 {
  34         my ($self, $c, $msg) = @_;
  35
  36         my ($x,$y,$z,$nick);
  37         if ($msg =~ /(\d+)\D+(\d+)\D+(\d+)/){
  38                 $x = $1;
  39                 $y = $2;
  40                 $z = $3;
  41         }elsif ($msg && $c->check_user_roles(qw/irc_p_nick/)){
  42                 $nick = $msg;
  43         }else{
  44                 die "ARGS";
  45         }
  46
  47         my $f = $c->model->prepare(q{
  48 SELECT coords(x,y,z),ruler,planet,race,score,size,value,scorerank,sizerank,
  49         valuerank, xp, xprank, alliance, relationship, nick, planet_status, hit_us, channel
  50 FROM current_planet_stats WHERE (x = $1 AND y = $2 and z = $3) OR nick ILIKE $4 LIMIT 1
  51         });
  52         $f->execute($x,$y,$z,$nick);
  53         if (my $planet = $f->fetchrow_hashref()){
  54                 for (keys %{$planet}){
  55                         $planet->{$_} = valuecolor(1,$planet->{$_});
  56                 }
  57                 my $ally = "";
  58                 if ($c->check_user_roles(qw/irc_p_intel/)){
  59                         $ally = "Alliance=$planet->{alliance} ($planet->{relationship}), Nick=$planet->{nick} ($planet->{planet_status}), Channel: $planet->{channel}, Hostile Count: $planet->{hit_us},";
  60                 }
  61                 $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})");
  62         }else{
  63                 $c->reply("Couldn't find planet: $msg");
  64         }
  65 }
  66
  67 sub g
  68         : Help(usage: .g X:Y)
  69 {
  70         my ($self, $c, $msg) = @_;
  71
  72         my ($x,$y) = ($msg =~ /(\d+)\D+(\d+)/) or die 'ARGS';
  73
  74         my $f = $c->model->prepare(q{
  75 SELECT score,scorerank,size,sizerank,value,valuerank,planets
  76 FROM galaxies WHERE x = ? AND y = ? AND tick = (SELECT max(tick) from galaxies)
  77         });
  78         $f->execute($x,$y);
  79         while (my @row = $f->fetchrow()){
  80                 @row = map (valuecolor(1),@row);
  81                 $c->reply("$x:$y  Score=$row[0] ($row[1]), Size=$row[2] ($row[3]), Value=$row[4] ($row[5]), Planets=$row[6]");
  82         }
  83 }
  84
  85 sub time
  86         : 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.)
  87 {
  88         my ($self, $c, $msg) = @_;
  89         my ($tick,$timezone) = $msg =~ /^(\d+)?\s*(\S+)?$/ or die 'ARGS';
  90
  91         eval {
  92                 $tick //= $c->model->selectrow_array(q{SELECT tick()});
  93                 $timezone //= 'GMT';
  94                 my $query = $c->model->prepare(q{
  95 SELECT date_trunc('seconds',now() + (($1 - tick()) || ' hr')::interval) AT TIME ZONE $2
  96                         });
  97                 $query->execute($tick,$timezone);
  98                 my $time = $query->fetchrow_array;
  99                 $c->reply("Time at tick <b>$tick</b>, timezone <b>$timezone</b>: <b>$time</b>");
 100         };
 101         given ($@){
 102                 when(/time zone "(.+?)" not recognized/){
 103                         $c->reply("<c04>$1</c> is not a valid timezone.");
 104                 }
 105                 die $@ if $@;
 106         }
 107 }
 108 1;