Commands/Scans.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::Scans;
  21
  22 use strict;
  23 use warnings;
  24 use feature ':5.10';
  25
  26 use Moose;
  27 use MooseX::MethodAttributes;
  28
  29 sub getscans
  30         : Help(syntax: .getscans X:Y:Z)
  31         : Type(pm)
  32 {
  33         my ($self,$c,$args) = @_;
  34         my ($x,$y,$z) = $args =~ /(\d+)\D+(\d+)\D+(\d+)/ or die 'ARGS';
  35         $c->reply("https://nd.ruin.nu/stats/find/$x:$y:$z");
  36 }
  37
  38 my %scanid = (p => 1, l => 2, d => 3, u => 4, n => 5, j => 7, a => 8);
  39
  40 my @scantypes = ('Planet','Landing', 'Development'
  41         ,'Unit', 'News', 'Incoming', 'Jumpgate', 'Advanced Unit');
  42
  43 sub gs
  44         : Help(syntax: gs type X:Y:Z message | type is the first character in the scan name, like p for planet scan, message is a message to scanners, like plz or thanks like plz or thanks)
  45         : ACL(irc_gs)
  46         : Type(pm)
  47 {
  48         my ($self,$c,$args) = @_;
  49
  50         my ($typeid, $x, $y, $z, $msg) = $args =~ /^([pdunja]) (\d+)\D+(\d+)\D+(\d+) (\S.*)/
  51                 or die 'ARGS';
  52         $typeid = $scanid{$typeid};
  53         my $type = $scantypes[$typeid-1];
  54
  55         my $planet = $c->model->selectrow_array(q{SELECT planetid($1,$2,$3,tick())}
  56                 ,undef,$x,$y,$z);
  57
  58         my $query = $c->model->prepare(q{SELECT scan_id
  59                 FROM scans
  60                 WHERE planet = $1 AND type = $2 AND tick >= tick()});
  61         $query->execute($planet,$type);
  62
  63         if (my $scan = $query->fetchrow_hashref){
  64                 $c->reply("scan already exist: "
  65                         . "http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}");
  66         }else{
  67                 my $req = $c->model->prepare(q{
  68 SELECT * FROM scan_requests
  69 WHERE uid = (SELECT uid FROM users WHERE hostmask ILIKE $1)
  70         AND planet = $2 AND type = $3 AND NOT sent
  71                 });
  72                 $req->execute($c->host,$planet,$type);
  73
  74                 my $id;
  75                 if(my $scan = $req->fetchrow_hashref){
  76                         $req = $c->model->prepare(q{
  77 UPDATE scan_requests SET nick = $1, tick = tick(), time = NOW()
  78 WHERE id = $2
  79                         });
  80                         $req->execute($c->nick,$scan->{id});
  81                         $id = $scan->{id};
  82                 }else{
  83                         $req = $c->model->prepare(q{
  84 INSERT INTO scan_requests (uid,nick,planet,type)
  85 VALUES((SELECT uid FROM users WHERE hostmask ILIKE $1),$2,$3,$4) RETURNING (id)
  86                         });
  87                         $req->execute($c->host,$c->nick,$planet,$type);
  88                         $id = $req->fetchrow;
  89                 }
  90
  91                 if ($id){
  92                         $c->message("msg $ND::scanchan"
  93                                 ,"<b>$id</b> http://game.planetarion.com/waves.pl?id=$typeid&x=$x&y=$y&z=$z"
  94                                 . " ($x:$y:$z $type) | <".$c->nick."> $msg"
  95                         );
  96                         $c->reply("sent request ($x:$y:$z $type)");
  97                 }else{
  98                         $c->reply("something went wrong..");
  99                 }
 100         }
 101 }
 102
 103 my %scantypes;
 104 {
 105         my $i = 1;
 106         %scantypes = map {$_ => $i++} @scantypes;
 107 }
 108
 109 sub scanreqs
 110         : Help(syntax: .scanreqs [-pdunja] | Lists scan requests that haven't been handled. The argument can be used to omit types you don't have, like .scanreqs -ja to list all requests except jumpgates and advanced unit scans.)
 111         : ACL(irc_scanreqs)
 112 {
 113         my ($self, $c, $msg) = @_;
 114
 115         my @notype;
 116         if ($msg =~ /^-([pdunja]+)$/){
 117                 for (split //, $1){
 118                         push @notype, $scantypes[$scanid{$_}-1];
 119                 }
 120         }elsif($msg){
 121                 die 'ARGS';
 122         }
 123
 124         my $reqs = $c->model->prepare(q{
 125 SELECT min(sr.id) AS id, x,y,z,type
 126 FROM scan_requests sr
 127         JOIN current_planet_stats p ON p.id = sr.planet
 128 WHERE sr.time > NOW() - '30 min'::INTERVAL
 129         AND NOT EXISTS (SELECT scan_id FROM scans
 130                 WHERE planet = sr.planet
 131                         AND type = sr.type
 132                         AND tick >= sr.tick
 133         )
 134         AND type <> ALL($1)
 135 GROUP BY x,y,z,type
 136 ORDER BY id
 137                 });
 138         $reqs->execute(\@notype);
 139         my $text = '';
 140         while (my $req = $reqs->fetchrow_hashref){
 141                 $text .= "<b>$req->{id}</b> http://game.planetarion.com/waves.pl?id=$scantypes{$req->{type}}&x=$req->{x}&y=$req->{y}&z=$req->{z} "
 142         }
 143
 144         $c->reply($text || 'No unhandled requests.');
 145 }
 146
 147 sub scan
 148         : Help(syntax: scan type X:Y:Z [tick] | type is the first character in the scan name, like p for planet scan. Specify a tick if you want scans older than the specified tick.)
 149         : ACL(irc_scan)
 150         : Type(pm)
 151 {
 152         my ($self, $c,$msg) = @_;
 153
 154         my ($t, $x, $y, $z, $tick)
 155                 = $msg =~ /^([pdunja]) (\d+)\D+(\d+)\D+(\d+)(?: (\d+))?/ or die 'ARGS';
 156         my $type =$scantypes[$scanid{$t}-1];
 157
 158         my $scan = $c->model->selectrow_hashref(q{
 159 SELECT id, scan_id, tick FROM scans
 160 WHERE type = $1 AND planet = planetid($2,$3,$4,0) AND COALESCE(tick < $5,TRUE)
 161 ORDER BY tick DESC LIMIT 1
 162                         },undef,$type,$x,$y,$z,$tick);
 163         unless ($scan->{id}){
 164                 $c->reply("No $type scan for $x:$y:$z. Planet might not exist.");
 165                 return;
 166         }
 167         my $text = '';
 168         given ($t){
 169                 when(/[ua]/){
 170                         my $fid = $c->model->selectrow_array(q{
 171 SELECT fid FROM fleet_scans WHERE id = $1
 172                         },undef,$scan->{id});
 173                         my $ships = $c->model->prepare(q{
 174 SELECT ship,amount FROM fleet_ships WHERE fid = $1 ORDER BY num
 175                         });
 176                         $ships->execute($fid);
 177                         while (my $ship = $ships->fetchrow_hashref){
 178                                 $text .= " $ship->{ship} $ship->{amount} |"
 179                         }
 180                 }
 181                 default {
 182                         $text = "http://game.planetarion.com/showscan.pl?scan_id=$scan->{scan_id}";
 183                 }
 184         }
 185         $c->reply("<b>$type</b> scan of $x:$y:$z "
 186                 . "($scan->{scan_id} pt: <b>$scan->{tick}</b>): $text");
 187 }
 188
 189 1;