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 #**************************************************************************/
25 use NDIRC::Dispatcher;
27 command sethostile => {
28 help => q(Usage: .sethostile X:Y:Z),
29 acl => q(irc_sethostile),
30 }, class extends NDIRC::Command {
31 method execute($c,$msg) {
32 my ($x,$y,$z) = $msg =~ /^(\d+)\D(\d+)\D(\d+)$/ or die 'ARGS';
35 my $findid = $dbh->prepare(q{SELECT planetid(?,?,?,tick())});
36 my ($id) = $dbh->selectrow_array($findid,undef,$x,$y,$z);
38 my $rv = $dbh->do(q{UPDATE planets SET planet_status = 'Hostile' WHERE pid = $1}
41 $c->reply("$x:$y:$z is now marked s hostile");
42 $c->intel_log($id,"Set planet_status to: 'Hostile'");
49 help => q(Usage: .setnick X:Y:Z nick),
50 acl => q(irc_setnick),
51 }, class extends NDIRC::Command {
52 method execute($c,$msg) {
53 my ($x,$y,$z,$nick) = $msg =~ /^(\d+)\D(\d+)\D(\d+) (\S+)$/ or die 'ARGS';
56 my $findid = $dbh->prepare(q{
57 SELECT nick, pid, alliance FROM planets WHERE pid = planetid(?,?,?,tick())
59 my $planet = $dbh->selectrow_hashref($findid,undef,$x,$y,$z);
60 unless($planet->{pid}){
61 $c->reply("Couldn't find any planet with coords $x:$y:$z");
62 }elsif($planet->{alliance} ~~ 'NewDawn'){
63 $c->reply("This is an ND planet.");
66 $dbh->do(q{UPDATE planets SET nick = $1 WHERE pid = $2}
67 ,undef,$nick,$planet->{pid});
69 $c->reply("$x:$y:$z nick has been changed from <b>$planet->{nick}</b> to <b>$nick</b>");
71 $c->reply("$x:$y:$z nick has been set to $nick");
73 $c->intel_log($planet->{pid},"Set nick to: $nick");
80 help => q(Usage: .setally X:Y:Z ally | % can be used for wildcards \%-crew\% will match [F-Crew]),
81 acl => q(irc_setally),
82 }, class extends NDIRC::Command {
83 method execute($c,$msg) {
84 my ($x,$y,$z,$ally) = $msg =~ /^(\d+)\D(\d+)\D(\d+) (\S+)$/ or die 'ARGS';
88 if ($ally ne 'unknown'){
89 ($aid,$ally) = $dbh->selectrow_array(q{
90 SELECT aid,alliance FROM alliances WHERE alliance ILIKE ?
94 $c->reply("Don't set ND planets manually.");
96 my $findid = $dbh->prepare(q{
97 SELECT pid,alliance,aid FROM current_planet_stats WHERE x = ? AND y = ? and z = ?
99 my ($id,$alliance,$alliance_id) = $dbh->selectrow_array($findid,undef,$x,$y,$z);
101 $c->reply("Couldn't find a planet at $x:$y:$z");
102 }elsif ($alliance_id ~~ 1){
103 $c->reply("$x:$y:$z is an ND planet.");
104 }elsif ($alliance_id ~~ $aid){
105 $c->reply("$x:$y:$z is already set to $ally");
108 $dbh->do(q{UPDATE planets SET alliance = NULLIF($1,'unknown') WHERE pid = $2}
110 if (defined $alliance){
111 $c->reply("Changed $x:$y:$z from <b>$alliance</b> to <b>$ally</b>");
113 $c->reply("Setting $x:$y:$z as <b>$ally</b>");
115 $c->intel_log($id,"Set alliance_id to: $aid ($ally)");
119 $c->reply("Couldn't find such an alliance");
124 command setchannel => {
125 help => q(Usage: .setchannel X:Y:Z channel | Set channel or bot for a planet),
126 acl => q(irc_setchannel),
127 }, class extends NDIRC::Command {
128 method execute($c,$msg) {
129 my ($x,$y,$z,$channel) = $msg =~ /^(\d+)\D(\d+)\D(\d+) (\S+)$/ or die 'ARGS';
132 my $findid = $dbh->prepare_cached(q{SELECT pid,channel FROM current_planet_stats
133 WHERE x = ? AND y = ? and z = ?});
134 my ($id,$oc) = $dbh->selectrow_array($findid,undef,$x,$y,$z);
135 if ($channel ~~ $oc){
136 $c->reply("$x:$y:$z already got $oc as channel");
139 $dbh->do(q{UPDATE planets SET channel = $1 WHERE pid = $2}
140 ,undef,$channel,$id);
141 $c->intel_log($id,"Set channel to: $channel");
144 $c->reply("Changed $x:$y:$z from <b>$oc</b> to <b>$channel</b>");
146 $c->reply("Setting $x:$y:$z as <b>$channel</b>");
149 $c->reply("Couldn't find a planet at $x:$y:$z");
155 help => q(Usage: .newtag tag | Creates a new tag that can be used with addtag, tags can only contain a-z, A-Z, 0-9 and _),
156 acl => q(irc_newtag),
158 }, class extends NDIRC::Command {
159 method execute($c,$msg) {
160 my ($tag) = $msg =~ /^(\w+)$/ or die 'ARGS';
163 my $query = $dbh->prepare(q{
164 INSERT INTO available_planet_tags (tag) VALUES($1)
167 $query->execute($tag);
169 if ($@ =~ /duplicate key value/){
170 $c->reply("<b>$tag</b> already exists");
175 $c->reply("Added tag <b>$tag</b>");
180 help => q(Usage: .addtag X:Y:Z tag | Adds the tag to planet X:Y:Z),
181 acl => q(irc_addtag),
183 }, class extends NDIRC::Command {
184 method execute($c,$msg) {
185 my ($x,$y,$z,$tag) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)\s+(\S+)$/ or die 'ARGS';
188 my $query = $dbh->prepare(q{
189 INSERT INTO planet_tags (uid,pid,tag) VALUES($1,planetid($2,$3,$4,tick()),$5)
192 $query->execute($c->uid,$x,$y,$z,$tag);
196 $c->reply("Added tag <b>$tag</b> to $x:$y:$z");
197 }when (/duplicate key value/){
198 $c->reply("$x:$y:$z already has tag <b>$tag</b>");
199 }when (/null value in column "pid"/){
200 $c->reply("No planet with coords $x:$y:$z");
201 }when ($@ =~ /foreign key constraint "planet_tags_tag_fkey"/){
202 $query = $dbh->prepare(q{
203 SELECT array_to_string(array_agg(tag),' ')
204 FROM (SELECT tag FROM available_planet_tags
205 WHERE tag % $1 ORDER BY similarity(tag,$1) DESC) t
207 my ($tags) = $dbh->selectrow_array($query,undef,$tag);
208 $c->reply("<b>$tag</b> is not a valid tag. Either you need to add it with .newtag,"
209 ." or you want one of: $tags");
219 help => q(Usage: .deltag X:Y:Z tag | Removes the tag from planet X:Y:Z),
220 acl => q(irc_addtag),
222 }, class extends NDIRC::Command {
223 method execute($c,$msg) {
224 my ($x,$y,$z,$tag) = $msg =~ /^(\d+)\D+(\d+)\D+(\d+)\s+(\S+)$/ or die 'ARGS';
227 my $query = $dbh->prepare(q{
228 DELETE FROM planet_tags WHERE uid = $1 AND pid = planetid($2,$3,$4,tick()) AND tag LIKE $5
230 $query->execute($c->uid,$x,$y,$z,$tag);
231 my $rows = $query->rows;
232 $c->reply("Removed <b>$rows</b> matching $tag from $x:$y:$z");
236 command allycoords => {
237 help => q(Usage: .allycoords ally | % can be used for wildcards \%-crew\% will match [F-Crew]),
238 acl => q(irc_allycoords),
239 }, class extends NDIRC::Command {
240 method execute($c,$msg) {
241 my ($ally) = $msg =~ /^(\S+)$/ or die 'ARGS';
244 my ($a, $members) = $dbh->selectrow_array(q{
245 SELECT alliance, members
246 FROM alliances JOIN alliance_stats USING (aid)
247 WHERE tick = (SELECT max(tick) FROM alliance_stats)
248 AND alliance ILIKE $1
251 $c->reply("No alliance matching '$ally'");
254 my $query = $dbh->prepare(q{
255 SELECT coords(x,y,z) FROM current_planet_stats WHERE alliance = $1 ORDER BY x,y,z
259 while (my $p = $query->fetchrow_hashref){
260 push @planets,$p->{coords};
262 my $kmem = scalar @planets;
263 $c->reply("$a ($kmem/$members) : ". join " ", @planets);
267 command allygals => {
268 help => q(Usage: .allygals ally [min] | lists gals with a minimum of 3, or specified, allied planets. % can be used for wildcards \%-crew\% will match [F-Crew]),
269 acl => q(irc_allygals),
270 }, class extends NDIRC::Command {
271 method execute($c,$msg) {
272 my ($ally,$min) = $msg =~ /^(\S+)(?: (\d+))?$/ or die 'ARGS';
276 my ($a) = $dbh->selectrow_array(q{
278 FROM alliances JOIN alliance_stats USING (aid)
279 WHERE tick = (SELECT max(tick) FROM alliance_stats)
280 AND alliance ILIKE $1
283 $c->reply("No alliance matching '$ally'");
286 my $query = $dbh->prepare(q{
287 SELECT x,y, count(*) FROM current_planet_stats WHERE alliance = $1
289 HAVING count(*) >= $2
290 ORDER BY count DESC,x,y
292 $query->execute($a,$min);
294 while (my $g = $query->fetchrow_hashref){
295 push @gals,"$g->{x}:$g->{y} ($g->{count})";
297 my $kgals = scalar @gals;
298 $c->reply("$a ($kgals) : ". join " ", @gals);