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         method execute($c,$msg) {
 237
 238                 $msg =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\s+(\d+)/
 239                 || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/
 240                         or return;
 241                 my $dbh = $c->model;
 242                 my $amount = $8;
 243                 {
 244                         $amount =~ s/,//g;
 245                 }
 246
 247                 my $st = $dbh->prepare(q{
 248 SELECT username, uid, pid, defprio
 249 FROM users_defprio u
 250 WHERE pid = planetid($1,$2,$3,tick())
 251         AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 252                         });
 253                 if (my $user = $dbh->selectrow_hashref($st,undef,$1,$2,$3)){
 254
 255                         $st = $dbh->prepare(q{
 256 SELECT nick,alliance,pid,planet_status,relationship
 257 FROM current_planet_stats WHERE x = ? AND y = ? AND z = ?
 258                         });
 259                         if (my @attacker = $dbh->selectrow_array($st,undef,$4,$5,$6)){
 260                                 $dbh->begin_work;
 261                                 my $landing_tick = $dbh->selectrow_array(q{SELECT tick() + ?},undef,$9);
 262                                 my @call = $dbh->selectrow_array(q{
 263 SELECT call,status,calc
 264 FROM calls WHERE uid = ? AND landing_tick = ?
 265                                 },undef,$user->{uid},$landing_tick);
 266                                 my $threefleeter = $dbh->selectrow_array(q{
 267 SELECT COALESCE(gid = 'X',false)
 268 FROM groupmembers WHERE uid = ? AND gid = 'X'
 269                                 },undef,$user->{uid});
 270                                 unless (@call){ #call doesn't exists, create a new one
 271                                         @call = $dbh->selectrow_array(q{
 272 INSERT INTO calls (uid,landing_tick,info) VALUES(?,?,'') RETURNING call,status,calc
 273                                         },undef,$user->{uid},$landing_tick);
 274                                         if ($threefleeter){
 275                                                 $dbh->do(q{UPDATE calls SET status = 'Ignored' WHERE call = $1},undef,$call[0]);
 276                                                 $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.');
 277                                                 $call[1] = 'Ignored';
 278                                         }
 279                                 }
 280                                 if (@call){
 281                                         my $pointlimits = $dbh->prepare(q{SELECT value :: float FROM misc WHERE id = ?});
 282                                         my ($minpoints) = $dbh->selectrow_array($pointlimits,undef,'DEFMINPRIO');
 283                                         my ($maxpoints) = $dbh->selectrow_array($pointlimits,undef,'DEFMAXPRIO');
 284                                         my $color = 3;
 285                                         if ($user->{defprio} < $minpoints){
 286                                                 $color = 5;
 287                                         }elsif ($user->{defprio} < $maxpoints){
 288                                                 $color = 8;
 289                                         }
 290                                         $user->{defprio} = "<c0$color>$user->{defprio}</c>";
 291                                         $st = $dbh->prepare(q{SELECT pid FROM incomings WHERE pid = ? AND amount = ? and fleet = ? AND call = ?});
 292                                         unless (my @inc = $dbh->selectrow_array($st,undef,$attacker[2],$amount,$7,$call[0])){
 293                                                 my $incid = $dbh->selectrow_array(q{
 294 INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING inc
 295                                                 },undef,$call[0],$attacker[2],$9,$amount,$7);
 296                                                 @attacker = map ($c->valuecolor(0),@attacker);
 297                                                 if (! $threefleeter || $call[1] ne 'Ignored'){
 298                                                         $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>");
 299                                                 }else{
 300                                                         $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]");
 301                                                 }
 302                                                 $dbh->do(q{UPDATE planets SET hit_us = hit_us + 1 WHERE pid = ?},undef,$attacker[2]);
 303                                                 if ($call[1] eq 'Covered'){
 304                                                         $dbh->do(q{UPDATE calls SET status = 'Open' WHERE call = ?},undef,$call[0]);
 305                                                         $c->reply("<b>Call is likely not covered anymore, please recalc! calc: $call[2]</b>");
 306                                                 }
 307                                         }else{
 308                                                 @attacker = map ($c->valuecolor(0),@attacker);
 309                                                 $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");
 310                                         }
 311
 312                                         my ($fleetcatch) = $dbh->selectrow_array(q{
 313 SELECT count(*) FROM launch_confirmations WHERE uid = ? AND back = ?
 314                                         },undef,$user->{uid},$landing_tick);
 315                                         if ($fleetcatch > 0){
 316                                                 $c->reply("<c04>THIS IS A POSSIBLE FLEETCATCH!</c>");
 317                                         }
 318                                 }
 319                                 $dbh->commit;
 320                         }else{
 321                                 $c->reply("<c04>Didn't find any planet with coordinates $4:$5:$6 at this tick</c>");
 322                         }
 323                 }else{
 324                         $c->reply("<c04>No member registered with coordinates $1:$2:$3</c>");
 325                 }
 326         }
 327 };
 328
 329 1;
 330