Commands/Def.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2009 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::Def;
  21
  22 use strict;
  23 use warnings;
  24 use feature ':5.10';
  25
  26 use CGI;
  27
  28 use Moose;
  29 use MooseX::MethodAttributes;
  30 use NDIRC::Misc;
  31
  32 sub anon
  33         : Help(syntax: .anon nick message)
  34         : Type(def)
  35         : ACL(irc_anondef)
  36 {
  37         my ($self,$c,$msg) = @_;
  38
  39         my ($target,$mess) = $msg =~ /^(\S+) (.*)$/ or die 'ARGS';
  40
  41         $c->message(privmsg => $target, "<b>$mess</b>");
  42         $c->message(privmsg => $c->channel, "<c03>$target << $mess</c>");
  43 }
  44
  45 sub defcall
  46         : 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)
  47         : Type(def)
  48         : ACL(irc_defcall)
  49 {
  50         my ($self,$c,$msg) = @_;
  51         my ($callnr,$mess) = $msg =~ /^(\d+)?(.*)$/ or die 'ARGS';
  52         my $dbh = $c->model;
  53
  54         my $callinfo = "";
  55         if ($callnr){
  56                 my $st = $dbh->prepare(q{
  57 SELECT status
  58         ,c.landing_tick - (SELECT value::integer FROM misc WHERE id = 'TICK') AS eta
  59         ,array_to_string(array_agg(i.shiptype),'/') AS shiptype
  60 FROM calls c
  61         JOIN incomings i USING (call)
  62         LEFT OUTER JOIN users dc ON dc.uid = c.dc
  63 WHERE c.call = ?
  64 GROUP BY c.call,c.landing_tick,c.status
  65 ORDER BY c.landing_tick;
  66                 });
  67                 my $call = $dbh->selectrow_hashref($st,undef,$callnr);
  68                 unless (defined $call->{status}){
  69                         $c->reply("No call with id: $callnr");
  70                         return;
  71                 }
  72                 $callinfo = "(Anti $call->{shiptype} ETA: $call->{eta})";
  73                 if($call->{status} eq 'Covered'){
  74                         $c->reply("Call <b>$callnr</b> $callinfo is covered.");
  75                         return;
  76                 }
  77         }
  78         $c->message(notice => $c->disp->targets->{members}, "DEFENSE REQUIRED!! WAKE UP!!");
  79         $c->message(privmsg => $c->disp->targets->{members}, "DEFENSE REQUIRED "
  80                 ."$mess $callinfo MSG ".$c->nick." TO RESPOND");
  81 }
  82
  83 sub settype
  84         : Help(Usage: .settype incId type | or: .settyp callId X:Y:Z type | or: .settypeall callId type)
  85         : Type(def)
  86         : ACL(irc_settype)
  87         : Alias(settypeall)
  88 {
  89         my ($self,$c,$msg) = @_;
  90         my $dbh = $c->model;
  91
  92         my $query = q{
  93 SELECT inc,call,shiptype, coords(x,y,z),c.landing_tick - tick() AS eta
  94 FROM incomings i
  95         JOIN current_planet_stats p USING (pid)
  96         JOIN calls c USING (call)
  97         };
  98         my $fleets;
  99         my $type;
 100         my $call;
 101
 102         if ($self->name eq 'settypeall'){
 103                 ($call,$type) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
 104
 105                 $fleets = $dbh->prepare($query . q{
 106 WHERE call = ?
 107                 });
 108                 $fleets->execute($call);
 109         }else{
 110                 my ($id,$x,$y,$z,$t) = $msg =~ /^(\d+) (\d+):(\d+):(\d+) (.*)$/;
 111                 if (defined $id){
 112                         $fleets = $dbh->prepare($query . q{
 113 WHERE call = ? AND pid = planetid(?,?,?,tick())
 114                         });
 115                         $fleets->execute($id,$x,$y,$z);
 116                 }else{
 117                         ($id,$t) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
 118                         $fleets = $dbh->prepare($query . q{
 119 WHERE inc = ?
 120                         });
 121                         $fleets->execute($id);
 122                 }
 123                 $type = $t;
 124         }
 125
 126         $type = CGI::escapeHTML($type);
 127         $dbh->begin_work;
 128         my $deflog = '';
 129         my $settype = $dbh->prepare(q{UPDATE incomings SET shiptype = ? WHERE inc = ?});
 130         while (my $inc = $fleets->fetchrow_hashref){
 131                 $call //= $inc->{call};
 132                 if ($inc->{eta} < 0){
 133                         $c->reply("This call is old. Did you use the call id instead of inc id by"
 134                                 ." accident? You can use .settypeall callid to set the type on all incs"
 135                                 ." in a call. Or use webbie if you really want to update this old call.");
 136                         $dbh->rollback;
 137                         return;
 138                 }
 139                 $settype->execute($type,$inc->{inc});
 140                 $deflog .= "Set fleet: [B]$inc->{inc} [/B] to: [B]$type [/B]\n";
 141                 $c->reply("Set fleet $inc->{inc} from $inc->{coords} on call $call to $type (previously $inc->{shiptype})");
 142         }
 143         if ($fleets->rows == 0){
 144                 $c->reply("No matching fleets");
 145                 $dbh->rollback;
 146         }else{
 147                 $c->def_log($call,$deflog);
 148                 $dbh->commit;
 149         }
 150 }
 151
 152 sub calltake
 153         : Help(Usage: .calltake callid | sets the dc. also markes as covered/ignored with .callcov and .callignore)
 154         : Type(def)
 155         : ACL(irc_calltake)
 156         : Alias(qw/callcov callignore/)
 157 {
 158         my ($self,$c,$msg) = @_;
 159         my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
 160         my $dbh = $c->model;
 161
 162         my $status = 'Open';
 163
 164         given ($self->{name}){
 165                 when('callignore'){
 166                         $status = 'Ignored';
 167                 }
 168                 when('callcov'){
 169                         $status = 'Covered';
 170                 }
 171         }
 172
 173         $dbh->begin_work;
 174         my $rows = $dbh->do(q{
 175 UPDATE calls SET dc = $1
 176         ,status = $3
 177 WHERE call = $2
 178                 },undef,$c->uid,$id,$status);
 179         if ($rows == 1){
 180                 $c->reply("Setting status on call $id to $status");
 181                 $c->def_log($id , "Changed status: [B]$status [/B]");
 182                 $dbh->commit;
 183         }else{
 184                 $c->reply("$id is not a valid call");
 185                 $dbh->rollback;
 186         }
 187 }
 188
 189 sub setcalc
 190         : Help(Usage: .setcalc callId calc | sets the calc for the given call.)
 191         : Type(def)
 192         : ACL(irc_setcalc)
 193 {
 194         my ($self,$c,$msg) = @_;
 195         my ($id,$calc) = $msg =~ /^(\d+) (.+)$/ or die 'ARGS';
 196         my $dbh = $c->model;
 197
 198         $dbh->begin_work;
 199         my $rows = $dbh->do(q{UPDATE calls SET calc = $2 WHERE call = $1}
 200                 ,undef,$id, $calc);
 201         if ($rows == 1){
 202                 $c->reply("Updated calc call <b>$id</b>");
 203                 $calc = CGI::escapeHTML($calc);
 204                 $c->def_log($id , 'Updated calc to: [URL]'.$calc.'[/URL]');
 205                 $dbh->commit;
 206         }else{
 207                 $c->reply("$id is not a valid call");
 208                 $dbh->rollback;
 209         }
 210 }
 211
 212 sub getcalc
 213         : Help(Usage: .getcalc callId | receives the calc for the given call)
 214         : Type(def)
 215         : ACL(irc_getcalc)
 216 {
 217         my ($self,$c,$msg) = @_;
 218         my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
 219         my $dbh = $c->model;
 220
 221         my $calc = $dbh->selectrow_array(q{
 222 SELECT calc FROM calls WHERE call = $1}
 223                 ,undef,$id);
 224         $calc //= "Bad call id, there is no such call.";
 225         $c->reply("Calc for call <b>$id</b>: $calc");
 226 }
 227
 228 sub report_incs
 229         : Help(Used to report incs, same as pasting in pm. Use ~ prefix to send output to channel)
 230         : Type(def)
 231 {
 232         my ($self,$c,$msg) = @_;
 233
 234         if ($msg =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\s+(\d+)/
 235                         || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/){
 236                 my $dbh = $c->model;
 237                 my $amount = $8;
 238                 {
 239                         $amount =~ s/,//g;
 240                 }
 241
 242                 my $st = $dbh->prepare(q{
 243 SELECT username, uid, pid, defprio
 244 FROM users_defprio u
 245 WHERE pid = planetid($1,$2,$3,tick())
 246         AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 247                         });
 248                 if (my $user = $dbh->selectrow_hashref($st,undef,$1,$2,$3)){
 249
 250                         $st = $dbh->prepare(q{
 251 SELECT nick,alliance,pid,planet_status,relationship
 252 FROM current_planet_stats WHERE x = ? AND y = ? AND z = ?
 253                         });
 254                         if (my @attacker = $dbh->selectrow_array($st,undef,$4,$5,$6)){
 255                                 $dbh->begin_work;
 256                                 my $landing_tick = $dbh->selectrow_array(q{SELECT tick() + ?},undef,$9);
 257                                 my @call = $dbh->selectrow_array(q{
 258 SELECT call,status,calc
 259 FROM calls WHERE uid = ? AND landing_tick = ?
 260                                 },undef,$user->{uid},$landing_tick);
 261                                 my $threefleeter = $dbh->selectrow_array(q{
 262 SELECT COALESCE(gid = 'X',false)
 263 FROM groupmembers WHERE uid = ? AND gid = 'X'
 264                                 },undef,$user->{uid});
 265                                 unless (@call){ #call doesn't exists, create a new one
 266                                         @call = $dbh->selectrow_array(q{
 267 INSERT INTO calls (uid,landing_tick,info) VALUES(?,?,'') RETURNING call,status,calc
 268                                         },undef,$user->{uid},$landing_tick);
 269                                         if ($threefleeter){
 270                                                 $dbh->do(q{UPDATE calls SET status = 'Ignored' WHERE call = $1},undef,$call[0]);
 271                                                 $c->def_log($call[0], 'This member has been marked as [B]NoDef[/B], do [B]not cover[/B] unless you have a good reaon.');
 272                                                 $call[1] = 'Ignored';
 273                                         }
 274                                 }
 275                                 if (@call){
 276                                         my $pointlimits = $dbh->prepare(q{SELECT value :: float FROM misc WHERE id = ?});
 277                                         my ($minpoints) = $dbh->selectrow_array($pointlimits,undef,'DEFMINPRIO');
 278                                         my ($maxpoints) = $dbh->selectrow_array($pointlimits,undef,'DEFMAXPRIO');
 279                                         my $color = 3;
 280                                         if ($user->{defprio} < $minpoints){
 281                                                 $color = 5;
 282                                         }elsif ($user->{defprio} < $maxpoints){
 283                                                 $color = 8;
 284                                         }
 285                                         $user->{defprio} = "<c0$color>$user->{defprio}</c>";
 286                                         $st = $dbh->prepare(q{SELECT pid FROM incomings WHERE pid = ? AND amount = ? and fleet = ? AND call = ?});
 287                                         unless (my @inc = $dbh->selectrow_array($st,undef,$attacker[2],$amount,$7,$call[0])){
 288                                                 my $incid = $dbh->selectrow_array(q{
 289 INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING inc
 290                                                 },undef,$call[0],$attacker[2],$9,$amount,$7);
 291                                                 @attacker = map (valuecolor(0),@attacker);
 292                                                 if (! $threefleeter || $call[1] ne 'Ignored'){
 293                                                         $c->reply("<b>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]</b>");
 294                                                 }else{
 295                                                         $c->reply("<b>Do not cover</b>, NoDef member is under attack by $4:$5:$6, ($attacker[3]), $attacker[1]($attacker[4])  https://nd.ruin.nu/calls/edit/$call[0]");
 296                                                 }
 297                                                 $dbh->do(q{UPDATE planets SET hit_us = hit_us + 1 WHERE pid = ?},undef,$attacker[2]);
 298                                                 if ($call[1] eq 'Covered'){
 299                                                         $dbh->do(q{UPDATE calls SET status = 'Open' WHERE call = ?},undef,$call[0]);
 300                                                         $c->reply("<b>Call is likely not covered anymore, please recalc! calc: $call[2]</b>");
 301                                                 }
 302                                         }else{
 303                                                 @attacker = map (valuecolor(0),@attacker);
 304                                                 $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");
 305                                         }
 306
 307                                         my ($fleetcatch) = $dbh->selectrow_array(q{
 308 SELECT count(*) FROM launch_confirmations WHERE uid = ? AND back = ?
 309                                         },undef,$user->{uid},$landing_tick);
 310                                         if ($fleetcatch > 0){
 311                                                 $c->reply("<c04>THIS IS A POSSIBLE FLEETCATCH!</c>");
 312                                         }
 313                                 }
 314                                 $dbh->commit;
 315                         }else{
 316                                 $c->reply("<c04>Didn't find any planet with coordinates $4:$5:$6 at this tick</c>");
 317                         }
 318                 }else{
 319                         $c->reply("<c04>No member registered with coordinates $1:$2:$3</c>");
 320                 }
 321         }
 322
 323 }
 324
 325 1;
 326