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