Commands/Usermgm.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 use MooseX::Declare;
  25 use NDIRC::Dispatcher;
  26
  27 command '+user' => {
  28         help => q(syntax: .+user username [pnick] | username must be alphanum characters, if no pnick is given then it will be set to the same as username),
  29         acl => 'irc_adduser'
  30 }, class extends NDIRC::Command {
  31         method execute ($c,$msg) {
  32                 my ($nick,$pnick) = $msg =~ /^(\w+)(?: ([^.\s]+))?$/ or die 'ARGS';
  33                 $pnick //= $nick;
  34
  35                 my $dbh = $c->model;
  36
  37                 my $host = "$pnick.users.netgamers.org";
  38                 my ($username,$hostname,$p_nick) = $dbh->selectrow_array(q{
  39 SELECT username, hostmask,pnick
  40 FROM users WHERE username = $1 OR hostmask = $2 OR pnick = $3
  41                         },undef,$nick,$host,$pnick);
  42
  43                 if (defined $username){
  44                         $c->reply("<b>$username ($p_nick)</b> already exists with host: <b>$hostname</b>");
  45                 }else{
  46                         $dbh->do(q{
  47 INSERT INTO users (username,hostmask,pnick,password) VALUES(?,?,?,'')
  48                                 },undef,$nick,$host,$pnick);
  49                         $c->reply("Added <b>$nick(/$pnick)</b> with host: <b>$host</b>");
  50                 }
  51         }
  52 };
  53
  54 command '-user' => {
  55         help => q(syntax: .-user nick | nick must be alphanum characters, if no pnick is given then it will be set to nick),
  56         acl => 'irc_deactivateuser'
  57 }, class extends NDIRC::Command {
  58         method execute ($c,$msg) {
  59                 my ($nick) = $msg =~ /^(\S+)$/ or die 'ARGS';
  60
  61                 my $dbh = $c->model;
  62                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
  63                 $f->execute($nick);
  64                 my ($uid,$username) = $f->fetchrow();
  65
  66                 if ($f->rows == 1){
  67                         my $updated = $dbh->do(q{
  68 UPDATE users SET hostmask = ?, password = '' WHERE uid = ?
  69                                 },undef,$username,$uid);
  70                         if ($updated > 0){
  71                                 my $groups = $dbh->do(q{DELETE FROM groupmembers WHERE uid = ?},undef,$uid);
  72                                 $groups += 0;
  73                                 $c->reply("<b>$username</b> has been deactivated. Removed from $groups groups.");
  74                         }else{
  75                                 $c->reply("Something went wrong when trying to modify <b>$username</b>");
  76                         }
  77                 }elsif ($f->rows == 0){
  78                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
  79                 }else{
  80                         $c->reply("More than 1 user matched, please refine the search");
  81                 }
  82                 $f->finish;
  83         }
  84 };
  85
  86 command chattr => {
  87         help => q(syntax: .chattr username [-]flags | % can be used for wildcards \%arro% will match barrow, if a - is given then flags will be removed, otherwise added),
  88         acl => 'irc_chattr'
  89 }, class extends NDIRC::Command {
  90         method execute ($c,$msg) {
  91                 my ($nick, $mode, $flags) = $msg =~ /^(\S+) (\+|-)?(\w+)$/ or die 'ARGS';
  92                 my $dbh = $c->model;
  93
  94                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
  95                 $f->execute($nick);
  96                 my $user = $f->fetchrow_hashref;
  97                 if ($f->rows == 1){
  98                         my $update;
  99                         if ($mode ~~ '-'){
 100                                 $update = $dbh->prepare(q{
 101 DELETE FROM groupmembers WHERE uid = $1 AND gid = ANY($2)
 102                                         });
 103                         }else{
 104                                 $update = $dbh->prepare(q{
 105 INSERT INTO groupmembers (uid,gid)
 106         (SELECT $1,gid FROM unnest($2::text[]) gid WHERE
 107                 gid NOT IN (SELECT gid FROM groupmembers WHERE uid = $1)
 108                 AND gid IN (SELECT gid FROM groups))
 109                                 });
 110                         }
 111                         my @flags = split /\W*/,$flags;
 112                         $update->execute($user->{uid},\@flags);
 113                         $update = $dbh->prepare(q{
 114 SELECT array_to_string(array_agg(gid),'')
 115 FROM (SELECT uid,gid FROM groupmembers ORDER BY uid,gid ) g
 116 WHERE uid = ?
 117                                 });
 118                         $flags = $dbh->selectrow_array($update,undef,$user->{uid});
 119                         $c->reply("Flags for <b>$user->{username}</b> are now: $flags");
 120                 }elsif ($f->rows == 0){
 121                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 122                 }else{
 123                         $c->reply("More than 1 user matched, please refine the search");
 124                 }
 125                 $f->finish;
 126         }
 127 };
 128
 129 command flags => {
 130         help => q(Lists all the available flags),
 131         acl => 'irc_whois'
 132 }, class extends NDIRC::Command {
 133         method execute ($c,$msg) {
 134                 my $dbh = $c->model;
 135                 my ($flags) = $dbh->selectrow_array(q{
 136 SELECT array_to_string(array_agg(gid||':'||groupname),', ') FROM groups
 137                         });
 138                 $c->reply("Current flags: $flags");
 139         }
 140 };
 141
 142 command whois => {
 143         help => q(syntax: .whois username | % can be used for wildcards \%arro% will match barrow.),
 144         acl => 'irc_whois'
 145 }, class extends NDIRC::Command {
 146         method execute ($c,$msg) {
 147                 my ($nick) = $msg =~ /^(\S+)$/ or die 'ARGS';
 148                 my $dbh = $c->model;
 149
 150
 151                 my $f = $dbh->prepare(q{
 152 SELECT username, pnick, hostmask, array_to_string(array_agg(gid),'') AS flags
 153 FROM users u
 154         LEFT OUTER JOIN (SELECT uid,gid FROM groupmembers ORDER BY uid,gid
 155         ) g USING (uid)
 156 WHERE username ILIKE ?
 157 GROUP BY username,pnick,hostmask LIMIT 5
 158                         });
 159                 $f->execute($nick);
 160                 while (my $user = $f->fetchrow_hashref){
 161                         $c->reply("<b>$user->{username} (/$user->{pnick})</b> flags: ($user->{flags}) host: $user->{hostmask}");
 162                 }
 163                 if ($f->rows == 0){
 164                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 165                 }
 166         }
 167 };
 168
 169 command flag => {
 170         help => q(syntax: .flag flag [-noflags] | Lists all users with the given flag. Can specify a second argument to remove members that has any of those flags. .flag M -C lists all members that doesn't have community flag),
 171         acl => 'irc_flag'
 172 }, class extends NDIRC::Command {
 173         method execute ($c,$msg) {
 174                 my ($flag,$noflag) = $msg =~ /^(\w)(?: -(\w+))?$/ or die 'ARGS';
 175                 $noflag //= '';
 176
 177                 my $f = $c->model->prepare(q{
 178 SELECT array_to_string(array_agg(username),', '),count(username)
 179 FROM (SELECT uid, username FROM users ORDER BY username) u
 180         JOIN groupmembers gm USING (uid)
 181 WHERE gid = $1 AND uid NOT IN (SELECT uid FROM groupmembers WHERE gid =  ANY($2))
 182                         });
 183                 my @noflag = split //, $noflag;
 184                 my ($users,$count) = $c->model->selectrow_array($f,undef,$flag,\@noflag);
 185                 $c->reply("<b>$count</b> Users with flag <b>$flag</b>: $users");
 186         }
 187 };
 188
 189 command laston => {
 190         help => q(syntax: .laston flag [days] | lists users and the number of days since they were last seen (irc|forum|claim). If days is specified it will only list users with at least that amount of idle time. Days can also specify forum and claim with irc|forum|claim syntax),
 191         acl => 'irc_laston'
 192 }, class extends NDIRC::Command {
 193         method execute ($c,$msg) {
 194                 my ($flag,$min,$forum,$claim) = $msg =~ /^(\w)(?: (\d+)(?:\|(\d+)\|(\d+))?)?$/
 195                         or die 'ARGS';
 196                 $min //= 0;
 197
 198                 my $f = $c->model->prepare(q{
 199 SELECT username, COALESCE(last::text,'?') AS last
 200         ,COALESCE(lastforum::text,'?') AS lastforum
 201         ,COALESCE(lastclaim::text,'?') AS lastclaim
 202 FROM (SELECT username
 203                 ,date_part('day',now() - laston)::int AS last
 204                 ,date_part('day',now() -
 205                         (SELECT max(time) FROM forum_thread_visits WHERE uid = u.uid)) AS lastforum
 206                 ,date_part('day',now() -
 207                         (SELECT max(timestamp) FROM raid_claims WHERE uid = u.uid)) AS lastclaim
 208         FROM users u
 209                 NATURAL JOIN groupmembers
 210         WHERE gid = $1
 211         ) a
 212 WHERE COALESCE(last >= $2,TRUE) AND COALESCE(lastforum >= $3,TRUE)
 213         AND COALESCE(lastclaim >= $4,TRUE)
 214 ORDER BY a.last DESC, a.lastforum DESC, a.lastclaim DESC
 215                         });
 216                 $f->execute($flag,$min,$forum,$claim);
 217
 218                 my $text;
 219                 my $i = 0;
 220                 while (my $user = $f->fetchrow_hashref){
 221                         $text .= "$user->{username}($user->{last}|$user->{lastforum}|$user->{lastclaim}) ";
 222                         $i++;
 223                 }
 224                 $c->reply("<b>$i</b> Users(days) with flag <b>$flag</b>: $text");
 225         }
 226 };
 227
 228
 229 command lastseen => {
 230         help => q(syntax: .lastseen username | Shows the number of days since the user(s) last visited irc, forum and raids),
 231         acl => 'irc_lastseen'
 232 }, class extends NDIRC::Command {
 233         method execute ($c,$msg) {
 234                 my ($username) = $msg =~ /^(\S+)$/ or die 'ARGS';
 235
 236                 my $f = $c->model->prepare(q{
 237 SELECT username, COALESCE(date_part('day',now() - laston)::text,'?') AS last
 238         ,COALESCE(date_part('day',now() - (SELECT max(time)
 239                 FROM forum_thread_visits WHERE uid = u.uid))::text,'?') AS lastforum
 240         ,COALESCE(date_part('day',now() - (SELECT max(timestamp)
 241                 FROM raid_claims WHERE uid = u.uid))::text,'?') AS lastclaim
 242 FROM users u
 243 WHERE username ILIKE $1 ORDER BY username
 244                         });
 245                 $f->execute($username);
 246
 247                 my $text;
 248                 my $i = 0;
 249                 while (my $user = $f->fetchrow_hashref){
 250                         $text .= "$user->{username}($user->{last}|$user->{lastforum}|$user->{lastclaim}) ";
 251                         $i++;
 252                 }
 253                 $c->reply("<b>$i</b> Users(days): $text");
 254         }
 255 }
 256
 257 command getships => {
 258         help => q(Usage: .getships ship | % can be used as wildcard, e.g. beet%, shipshome shows the number of ships currently home),
 259         alias => 'shipshome',
 260         acl => 'irc_getships'
 261 }, class extends NDIRC::Command {
 262         method execute ($c,$msg) {
 263                 my ($ship) = $msg =~ /^(\S+)$/ or die 'ARGS';
 264                 my $dbh = $c->model;
 265
 266                 my $f = $dbh->prepare(q{
 267 SELECT username,SUM(fs.amount) AS amount
 268 FROM users u
 269         JOIN (SELECT DISTINCT ON (pid) pid,fid FROM fleets
 270                 WHERE mission = 'Full fleet' AND name <> 'Unit'
 271                 ORDER BY pid,tick DESC,fid DESC
 272         ) f  USING (pid)
 273         JOIN fleet_ships fs USING (fid)
 274 WHERE ship ILIKE $1 AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 275 GROUP BY username ORDER BY amount DESC
 276                         });
 277                 if ($self->name eq 'shipshome'){
 278                         $f = $dbh->prepare(q{
 279 SELECT username,SUM(amount) AS amount
 280 FROM available_ships
 281 WHERE ship ILIKE ? AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 282 GROUP BY username ORDER BY amount DESC
 283                                 });
 284                 }
 285                 $f->execute($ship);
 286                 my $text;
 287                 my $i = 0;
 288                 my $total = 0;
 289                 while (my $user = $f->fetchrow_hashref){
 290                         $text .= "$user->{username}: $user->{amount} ";
 291                         $i++;
 292                         $total += $user->{amount};
 293                 }
 294                 if ($text){
 295                         $c->reply("<b>$i</b> Users with <b>$total $ship</b>: $text");
 296                 }else{
 297                         $c->reply("Couldn't find any user with <b>$ship</b>");
 298                 }
 299         }
 300 };
 301
 302 command getfleet => {
 303         help => q(Usage: .getfleet username | % can be used as wildcard, e.g. barr%),
 304         acl => q(irc_getfleet)
 305 }, class extends NDIRC::Command {
 306         method execute ($c,$msg) {
 307                 my ($nick) = $msg =~ /^(\S+)$/ or die 'ARGS';
 308                 my $dbh = $c->model;
 309
 310                 my $f = $dbh->prepare(q{
 311 SELECT fs.ship, fs.amount, username
 312 FROM fleet_ships fs
 313         JOIN (SELECT fid,username
 314                 FROM fleets f
 315                         JOIN users u USING (pid)
 316                 WHERE mission = 'Full fleet' AND name <> 'Unit'
 317                         AND username ILIKE $1
 318                 ORDER BY pid,tick DESC,fid DESC
 319                 LIMIT 1
 320         ) f  USING (fid)
 321 ORDER BY num
 322                         });
 323                 $f->execute($nick);
 324                 my $text;
 325                 my $username;
 326                 while (my $ship = $f->fetchrow_hashref){
 327                         unless (defined $username) {
 328                                 $username = $ship->{username};
 329                                 $text = "<b>$username</b> has: "
 330                         }
 331                         $text .= "$ship->{ship} $ship->{amount} ";
 332                 }
 333                 if ($text){
 334                         $c->reply($text);
 335                 }else{
 336                         $c->reply("Couldn't find any fleet for $nick");
 337                 }
 338         }
 339 };
 340
 341 command sethost => {
 342         help => q(Usage: .sethost username [host] | if host isn't given then it resets to netgamers host),
 343         acl => q(irc_sethost)
 344 }, class extends NDIRC::Command {
 345         method execute ($c,$msg) {
 346                 my ($nick,$host) = $msg =~ /^(\S+)(?: (\S+))?$/ or die 'ARGS';
 347                 my $dbh = $c->model;
 348
 349                 my $f = $dbh->prepare(q{
 350 SELECT uid,username,pnick,hostmask FROM users WHERE username ILIKE ?
 351                         });
 352                 $f->execute($nick);
 353                 my $user = $f->fetchrow_hashref;
 354                 if ($f->rows == 1){
 355                         $host //= "$user->{pnick}.users.netgamers.org";
 356                         eval{
 357                                 $dbh->do(q{UPDATE users SET hostmask = ? WHERE uid = ?}
 358                                         ,undef,$host,$user->{uid});
 359                                 $c->reply("Updated <b>$user->{username}</b>'s host to: <b>$host</b>");
 360                         };
 361                         if($@){
 362                                 if ($@ =~ /duplicate key value violates unique constraint/){
 363                                         my ($username, $hostname) = $dbh->selectrow_array(q{
 364 SELECT username,hostmask FROM users WHERE hostmask = $1
 365                                                 },undef,$host);
 366                                         $c->reply("<c04>Problem</c>, <b>$username</b> already uses host <b>$hostname</b>.");
 367                                 }else{
 368                                         die $@;
 369                                 }
 370                         }
 371                 }elsif ($f->rows == 0){
 372                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 373                 }else{
 374                         $c->reply("More than 1 user matched, please refine the search");
 375                 }
 376                 $f->finish;
 377         }
 378 };
 379
 380 command setpnick => {
 381         help => q(Usage: .setpnick username pnick | Changes a user's pnick),
 382         acl => q(irc_setpnick)
 383 }, class extends NDIRC::Command {
 384         method execute ($c,$msg) {
 385                 my ($nick,$pnick) = $msg =~ /^(\S+) (\S+)$/ or die 'ARGS';
 386                 my $dbh = $c->model;
 387
 388                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
 389                 $f->execute($nick);
 390                 my $user = $f->fetchrow_hashref;
 391                 if ($f->rows == 1){
 392                         my $hostname = "$pnick.users.netgamers.org";
 393                         eval{
 394                                 $dbh->do(q{UPDATE users SET pnick = ?, hostmask = ? WHERE uid = ?}
 395                                         ,undef,$pnick,$hostname,$user->{uid});
 396                                 $c->reply("Updated <b>$user->{username}</b>'s pnick to: <b>$pnick</b> and hostname to <b>$hostname</b>");
 397                         };
 398                         if($@){
 399                                 if ($@ =~ /duplicate key value violates unique constraint/){
 400                                         my ($username, $hostname, $pnick) = $dbh->selectrow_array(q{
 401 SELECT username,hostmask,pnick FROM users WHERE hostmask = $1 OR pnick = $2
 402                                                 },undef,$hostname, $pnick);
 403                                         $c->reply("<c04>Problem</c>, <b>$username</b> already uses host <b>$hostname</b> and pnick <b>$pnick</b>.");
 404                                 }else{
 405                                         die $@;
 406                                 }
 407                         }
 408                 }elsif ($f->rows == 0){
 409                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 410                 }else{
 411                         $c->reply("More than 1 user matched, please refine the search");
 412                 }
 413                 $f->finish;
 414         }
 415 };
 416
 417 my $points = class extends NDIRC::Command {
 418         has point => (
 419                 is => 'ro',
 420                 isa => 'Str',
 421                 required => 1
 422         );
 423         method execute ($c,$msg) {
 424                 my ($nick,$points) = $msg =~ /^(\S+)(?: (-?(:?\d+|\d*\.\d+)))?$/ or die 'ARGS';
 425
 426                 return unless $self->check($c,$nick);
 427
 428                 $points //= 1;
 429
 430                 my $dbh = $c->model;
 431
 432                 if ($points*$points > 400){
 433                         $c->reply("Values between -20 and 20 please");
 434                         return;
 435                 }
 436
 437                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
 438                 $f->execute($nick);
 439                 my $user = $f->fetchrow_hashref;
 440                 if ($f->rows == 1){
 441                         my $type .= $self->point . "_points";
 442                         $dbh->do(qq{UPDATE users SET $type = $type + ? WHERE uid = ?}
 443                                 ,undef,$points,$user->{uid});
 444                         $c->reply("$user->{username} has been given $points $type");
 445                 }elsif ($f->rows == 0){
 446                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 447                 }else{
 448                         $c->reply("More than 1 user matched, please refine the search");
 449                 }
 450                 $f->finish;
 451         }
 452         method check ($c,$nick) {
 453                 return 1;
 454         }
 455 };
 456
 457 command a => {
 458         help => q(Usage: .a username [points] | % can be used for wildcards %arro% will match barrow, if the number of points isn't specified, then 1 will be assumed.),
 459         point => 'attack',
 460         acl => q(irc_a)
 461 }, class {
 462         extends $points->name;
 463         method check ($c,$nick) {
 464                 my ($fleets) = $c->model->selectrow_array(q{
 465 SELECT count(*) FROM raids r
 466         JOIN raid_targets rt ON r.id = rt.raid
 467         JOIN raid_claims rc ON rt.id = rc.target
 468 WHERE not launched  AND tick + 24 > tick()
 469         AND uid = (SELECT uid FROM users WHERE username ILIKE $1);
 470                         },undef,$nick);
 471
 472                 if ($fleets > 0 && $points > 0){
 473                         $c->reply("$nick has $fleets claimed waves the last 24 ticks that aren't marked as launched, so no points.");
 474                         return 0;
 475                 }
 476                 return 1;
 477         }
 478 };
 479
 480 command d => {
 481         help => q(Usage: .d username [points] | % can be used for wildcards %arro% will match barrow, if the number of points isn't specified, then 1 will be assumed.),
 482         acl => q(irc_d),
 483         point => 'defense',
 484         type => q(def)
 485 }, $points;
 486
 487 command s => {
 488         help => q(Usage: .s username [points] | % can be used for wildcards %arro% will match barrow, if the number of points isn't specified, then 1 will be assumed.),
 489         point => 'scan',
 490         acl => q(irc_s),
 491 }, $points;
 492
 493 command h => {
 494         help => q(Usage: .h username [points] | % can be used for wildcards %arro% will match barrow, if the number of points isn't specified, then 1 will be assumed.),
 495         point => 'humor',
 496         acl => q(irc_h),
 497 }, $points;
 498
 499 1;