1 #**************************************************************************
2 # Copyright (C) 2009 by Michael Andreen <harvATruinDOTnu> *
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. *
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. *
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 #**************************************************************************/
20 package NDIRC::Commands::Def;
29 use MooseX::MethodAttributes;
33 : Help(syntax: .anon nick message)
37 my ($self,$c,$msg) = @_;
39 my ($target,$mess) = $msg =~ /^(\S+) (.*)$/ or die 'ARGS';
41 $c->message(privmsg => $target, "<b>$mess</b>");
42 $c->message(privmsg => $c->channel, "<c03>$target << $mess</c>");
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)
50 my ($self,$c,$msg) = @_;
51 my ($callnr,$mess) = $msg =~ /^(\d+)?(.*)$/ or die 'ARGS';
56 my $st = $dbh->prepare(q{
58 ,c.landing_tick - (SELECT value::integer FROM misc WHERE id = 'TICK') AS eta
59 ,array_to_string(array_agg(i.shiptype),'/') AS shiptype
61 JOIN incomings i USING (call)
62 LEFT OUTER JOIN users dc ON dc.uid = c.dc
64 GROUP BY c.call,c.landing_tick,c.status
65 ORDER BY c.landing_tick;
67 my $call = $dbh->selectrow_hashref($st,undef,$callnr);
68 unless (defined $call->{status}){
69 $c->reply("No call with id: $callnr");
72 $callinfo = "(Anti $call->{shiptype} ETA: $call->{eta})";
73 if($call->{status} eq 'Covered'){
74 $c->reply("Call <b>$callnr</b> $callinfo is covered.");
78 $c->message(notice => $ND::memchan, "DEFENSE REQUIRED!! WAKE UP!!");
79 $c->message(privmsg => $ND::memchan, "DEFENSE REQUIRED $mess $callinfo MSG "
80 .$c->nick." TO RESPOND");
84 : Help(Usage: .settype incId type | or: .settyp callId X:Y:Z type | or: .settypeall callId type)
89 my ($self,$c,$msg) = @_;
93 SELECT inc,call,shiptype, coords(x,y,z),c.landing_tick - tick() AS eta
95 JOIN current_planet_stats p USING (pid)
96 JOIN calls c USING (call)
102 if ($self->name eq 'settypeall'){
103 ($call,$type) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
105 $fleets = $dbh->prepare($query . q{
108 $fleets->execute($call);
110 my ($id,$x,$y,$z,$t) = $msg =~ /^(\d+) (\d+):(\d+):(\d+) (.*)$/;
112 $fleets = $dbh->prepare($query . q{
113 WHERE call = ? AND pid = planetid(?,?,?,tick())
115 $fleets->execute($id,$x,$y,$z);
117 ($id,$t) = $msg =~ /^(\d+) (.*)$/ or die 'ARGS';
118 $fleets = $dbh->prepare($query . q{
121 $fleets->execute($id);
126 $type = CGI::escapeHTML($type);
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.");
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})");
143 if ($fleets->rows == 0){
144 $c->reply("No matching fleets");
147 $c->def_log($call,$deflog);
153 : Help(Usage: .calltake callid | sets the dc. also markes as covered/ignored with .callcov and .callignore)
156 : Alias(qw/callcov callignore/)
158 my ($self,$c,$msg) = @_;
159 my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
164 given ($self->{name}){
174 my $rows = $dbh->do(q{
175 UPDATE calls SET dc = (SELECT uid FROM users WHERE hostmask ILIKE $1)
178 },undef,$c->host,$id,$status);
180 $c->reply("Setting status on call $id to $status");
181 $c->def_log($id , "Changed status: [B]$status [/B]");
184 $c->reply("$id is not a valid call");
190 : Help(Usage: .setcalc callId calc | sets the calc for the given call.)
194 my ($self,$c,$msg) = @_;
195 my ($id,$calc) = $msg =~ /^(\d+) (.+)$/ or die 'ARGS';
199 my $rows = $dbh->do(q{UPDATE calls SET calc = $2 WHERE id = $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]');
207 $c->reply("$id is not a valid call");
213 : Help(Usage: .getcalc callId | receives the calc for the given call)
217 my ($self,$c,$msg) = @_;
218 my ($id) = $msg =~ /^(\d+)$/ or die 'ARGS';
221 my $calc = $dbh->selectrow_array(q{
222 SELECT calc FROM calls WHERE id = $1}
224 $calc //= "Bad call id, there is no such call.";
225 $c->reply("Calc for call <b>$id</b>: $calc");
231 my ($self,$c,$msg) = @_;
233 if ($msg =~ /(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\s+([^:]*\S+)\s+(?:Ter|Cat|Xan|Zik|Etd)\s+([\d,]+)\s+Attack\s+(\d+)/
234 || $msg =~ /(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:Ter|Cat|Xan|Zik|Etd)\)\s+([^,]*\S+)\s+([\d,]+)\s+(\d+)\s+\(\d+\)/){
241 my $st = $dbh->prepare(q{
242 SELECT username, uid, pid, defprio
244 WHERE pid = planetid($1,$2,$3,tick())
245 AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
247 if (my $user = $dbh->selectrow_hashref($st,undef,$1,$2,$3)){
249 $st = $dbh->prepare(q{
250 SELECT nick,alliance,pid,planet_status,relationship
251 FROM current_planet_stats WHERE x = ? AND y = ? AND z = ?
253 if (my @attacker = $dbh->selectrow_array($st,undef,$4,$5,$6)){
255 my $landing_tick = $dbh->selectrow_array(q{SELECT tick() + ?},undef,$9);
256 my @call = $dbh->selectrow_array(q{
257 SELECT call,status,calc
258 FROM calls WHERE uid = ? AND landing_tick = ?
259 },undef,$user->{uid},$landing_tick);
260 my $threefleeter = $dbh->selectrow_array(q{
261 SELECT COALESCE(gid = 'X',false)
262 FROM groupmembers WHERE uid = ? AND gid = 'X'
263 },undef,$user->{uid});
264 unless (@call){ #call doesn't exists, create a new one
265 @call = $dbh->selectrow_array(q{
266 INSERT INTO calls (uid,landing_tick,info) VALUES(?,?,'') RETURNING call
267 },undef,$user->{uid},$landing_tick);
269 $dbh->do(q{UPDATE calls SET status = 'Ignored' WHERE call = $1},undef,$call[0]);
270 $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.');
274 my $pointlimits = $dbh->prepare(q{SELECT value :: float FROM misc WHERE id = ?});
275 my ($minpoints) = $dbh->selectrow_array($pointlimits,undef,'DEFMINPRIO');
276 my ($maxpoints) = $dbh->selectrow_array($pointlimits,undef,'DEFMAXPRIO');
278 if ($user->{defprio} < $minpoints){
280 }elsif ($user->{defprio} < $maxpoints){
283 $user->{defprio} = "<c0$color>$user->{defprio}</c>";
284 $st = $dbh->prepare(q{SELECT pid FROM incomings WHERE pid = ? AND amount = ? and fleet = ? AND call = ?});
285 unless (my @inc = $dbh->selectrow_array($st,undef,$attacker[2],$amount,$7,$call[0])){
286 my $incid = $dbh->selectrow_array(q{
287 INSERT INTO incomings (call,pid,eta,amount,fleet) VALUES(?,?,?,?,?) RETURNING inc
288 },undef,$call[0],$attacker[2],$9,$amount,$7);
289 @attacker = map (valuecolor(0),@attacker);
290 if (! $threefleeter || $call[2]){
291 $c->message(privmsg => $ND::defchan, "<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>");
293 $c->message(privmsg => $ND::defchan, "<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]");
295 $dbh->do(q{UPDATE planets SET hit_us = hit_us + 1 WHERE pid = ?},undef,$attacker[2]);
296 if ($call[1] eq 'Covered'){
297 $dbh->do(q{UPDATE calls SET status = 'Open' WHERE call = ?},undef,$call[0]);
298 $c->message(privmsg => $ND::defchan, "<b>Call is likely not covered anymore, please recalc! calc: $call[3]</b>");
301 @attacker = map (valuecolor(0),@attacker);
302 $c->message(privmsg => $ND::defchan, "Duplicate call: Callid: $call[0], Covered: $call[1], Open: $call[2] $1:$2:$3 ($user->{defprio}) is under Attack by $4:$5:$6, ($attacker[3]), $attacker[1]($attacker[4]), landing tick: $landing_tick");
305 my ($fleetcatch) = $dbh->selectrow_array(q{
306 SELECT count(*) FROM launch_confirmations WHERE uid = ? AND back = ?
307 },undef,$user->{uid},$landing_tick);
308 if ($fleetcatch > 0){
309 $c->message(privmsg => $ND::defchan, "<c04>THIS IS A POSSIBLE FLEETCATCH!</c>");
314 $c->message(privmsg => $ND::defchan, "<c04>Didn't find any planet with coordinates $4:$5:$6 at this tick</c>");
317 $c->message(privmsg => $ND::defchan, "<c04>No member registered with coordinates $1:$2:$3</c>");