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