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