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         type => q(usermgmt),
  30         acl => 'irc_adduser'
  31 }, class extends NDIRC::Command {
  32         method execute ($c,$msg) {
  33                 my ($nick,$pnick) = $msg =~ /^(\w+)(?: ([^.\s]+))?$/ or die 'ARGS';
  34                 $pnick //= $nick;
  35
  36                 my $dbh = $c->model;
  37
  38                 my $host = "$pnick.users.netgamers.org";
  39                 my ($username,$hostname,$p_nick) = $dbh->selectrow_array(q{
  40 SELECT username, hostmask,pnick
  41 FROM users WHERE username = $1 OR hostmask = $2 OR pnick = $3
  42                         },undef,$nick,$host,$pnick);
  43
  44                 if (defined $username){
  45                         $c->reply("<b>$username ($p_nick)</b> already exists with host: <b>$hostname</b>");
  46                 }else{
  47                         $dbh->do(q{
  48 INSERT INTO users (username,hostmask,pnick) VALUES($1,$2,$3)
  49                                 },undef,$nick,$host,$pnick);
  50                         $c->reply("Added <b>$nick(/$pnick)</b> with host: <b>$host</b>");
  51                 }
  52         }
  53 };
  54
  55 command '-user' => {
  56         help => q(syntax: .-user nick | nick must be alphanum characters, if no pnick is given then it will be set to nick),
  57         type => q(usermgmt),
  58         acl => 'irc_deactivateuser'
  59 }, class extends NDIRC::Command {
  60         method execute ($c,$msg) {
  61                 my ($nick) = $msg =~ /^(\S+)$/ or die 'ARGS';
  62
  63                 my $dbh = $c->model;
  64                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
  65                 $f->execute($nick);
  66                 my ($uid,$username) = $f->fetchrow();
  67
  68                 if ($f->rows == 1){
  69                         my $updated = $dbh->do(q{
  70 UPDATE users SET hostmask = $1, password = NULL WHERE uid = $2
  71                                 },undef,$username,$uid);
  72                         if ($updated > 0){
  73                                 my $groups = $dbh->do(q{DELETE FROM groupmembers WHERE uid = ?},undef,$uid);
  74                                 $groups += 0;
  75                                 $c->reply("<b>$username</b> has been deactivated. Removed from $groups groups.");
  76                         }else{
  77                                 $c->reply("Something went wrong when trying to modify <b>$username</b>");
  78                         }
  79                 }elsif ($f->rows == 0){
  80                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
  81                 }else{
  82                         $c->reply("More than 1 user matched, please refine the search");
  83                 }
  84                 $f->finish;
  85         }
  86 };
  87
  88 command chattr => {
  89         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),
  90         type => q(usermgmt),
  91         acl => 'irc_chattr'
  92 }, class extends NDIRC::Command {
  93         method execute ($c,$msg) {
  94                 my ($nick, $mode, $flags) = $msg =~ /^(\S+) (\+|-)?(\w+)$/ or die 'ARGS';
  95                 my $dbh = $c->model;
  96
  97                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
  98                 $f->execute($nick);
  99                 my $user = $f->fetchrow_hashref;
 100                 if ($f->rows == 1){
 101                         my $update;
 102                         if ($mode ~~ '-'){
 103                                 $update = $dbh->prepare(q{
 104 DELETE FROM groupmembers WHERE uid = $1 AND gid = ANY($2)
 105                                         });
 106                         }else{
 107                                 $update = $dbh->prepare(q{
 108 INSERT INTO groupmembers (uid,gid)
 109         (SELECT $1,gid FROM unnest($2::text[]) gid WHERE
 110                 gid NOT IN (SELECT gid FROM groupmembers WHERE uid = $1)
 111                 AND gid IN (SELECT gid FROM groups))
 112                                 });
 113                         }
 114                         my @flags = split /\W*/,$flags;
 115                         $update->execute($user->{uid},\@flags);
 116                         $update = $dbh->prepare(q{
 117 SELECT array_to_string(array_agg(gid),'')
 118 FROM (SELECT uid,gid FROM groupmembers ORDER BY uid,gid ) g
 119 WHERE uid = ?
 120                                 });
 121                         $flags = $dbh->selectrow_array($update,undef,$user->{uid});
 122                         $c->reply("Flags for <b>$user->{username}</b> are now: $flags");
 123                 }elsif ($f->rows == 0){
 124                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 125                 }else{
 126                         $c->reply("More than 1 user matched, please refine the search");
 127                 }
 128                 $f->finish;
 129         }
 130 };
 131
 132 command flags => {
 133         help => q(Lists all the available flags),
 134         acl => 'irc_whois'
 135 }, class extends NDIRC::Command {
 136         method execute ($c,$msg) {
 137                 my $dbh = $c->model;
 138                 my ($flags) = $dbh->selectrow_array(q{
 139 SELECT array_to_string(array_agg(gid||':'||groupname),', ') FROM groups
 140                         });
 141                 $c->reply("Current flags: $flags");
 142         }
 143 };
 144
 145 command whois => {
 146         help => q(syntax: .whois username | % can be used for wildcards \%arro% will match barrow.),
 147         acl => 'irc_whois'
 148 }, class extends NDIRC::Command {
 149         method execute ($c,$msg) {
 150                 my ($nick) = $msg =~ /^(\S+)$/ or die 'ARGS';
 151                 my $dbh = $c->model;
 152
 153
 154                 my $f = $dbh->prepare(q{
 155 SELECT username, pnick, hostmask, array_to_string(array_agg(gid),'') AS flags
 156 FROM users u
 157         LEFT OUTER JOIN (SELECT uid,gid FROM groupmembers ORDER BY uid,gid
 158         ) g USING (uid)
 159 WHERE username ILIKE ?
 160 GROUP BY username,pnick,hostmask LIMIT 5
 161                         });
 162                 $f->execute($nick);
 163                 while (my $user = $f->fetchrow_hashref){
 164                         $c->reply("<b>$user->{username} (/$user->{pnick})</b> flags: ($user->{flags}) host: $user->{hostmask}");
 165                 }
 166                 if ($f->rows == 0){
 167                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 168                 }
 169         }
 170 };
 171
 172 command flag => {
 173         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),
 174         acl => 'irc_flag'
 175 }, class extends NDIRC::Command {
 176         method execute ($c,$msg) {
 177                 my ($flag,$noflag) = $msg =~ /^(\w)(?: -(\w+))?$/ or die 'ARGS';
 178                 $noflag //= '';
 179
 180                 my $f = $c->model->prepare(q{
 181 SELECT array_to_string(array_agg(username),', '),count(username)
 182 FROM (SELECT uid, username FROM users ORDER BY username) u
 183         JOIN groupmembers gm USING (uid)
 184 WHERE gid = $1 AND uid NOT IN (SELECT uid FROM groupmembers WHERE gid =  ANY($2))
 185                         });
 186                 my @noflag = split //, $noflag;
 187                 my ($users,$count) = $c->model->selectrow_array($f,undef,$flag,\@noflag);
 188                 $c->reply("<b>$count</b> Users with flag <b>$flag</b>: $users");
 189         }
 190 };
 191
 192 command laston => {
 193         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),
 194         acl => 'irc_laston'
 195 }, class extends NDIRC::Command {
 196         method execute ($c,$msg) {
 197                 my ($flag,$min,$forum,$claim) = $msg =~ /^(\w)(?: (\d+)(?:\|(\d+)\|(\d+))?)?$/
 198                         or die 'ARGS';
 199                 $min //= 0;
 200
 201                 my $f = $c->model->prepare(q{
 202 SELECT username, COALESCE(last::text,'?') AS last
 203         ,COALESCE(lastforum::text,'?') AS lastforum
 204         ,COALESCE(lastclaim::text,'?') AS lastclaim
 205 FROM (SELECT username
 206                 ,date_part('day',now() - laston)::int AS last
 207                 ,date_part('day',now() -
 208                         (SELECT max(time) FROM forum_thread_visits WHERE uid = u.uid)) AS lastforum
 209                 ,date_part('day',now() -
 210                         (SELECT max(timestamp) FROM raid_claims WHERE uid = u.uid)) AS lastclaim
 211         FROM users u
 212                 NATURAL JOIN groupmembers
 213         WHERE gid = $1
 214         ) a
 215 WHERE COALESCE(last >= $2,TRUE) AND COALESCE(lastforum >= $3,TRUE)
 216         AND COALESCE(lastclaim >= $4,TRUE)
 217 ORDER BY a.last DESC, a.lastforum DESC, a.lastclaim DESC
 218                         });
 219                 $f->execute($flag,$min,$forum,$claim);
 220
 221                 my $text;
 222                 my $i = 0;
 223                 while (my $user = $f->fetchrow_hashref){
 224                         $text .= "$user->{username}($user->{last}|$user->{lastforum}|$user->{lastclaim}) ";
 225                         $i++;
 226                 }
 227                 $c->reply("<b>$i</b> Users(days) with flag <b>$flag</b>: $text");
 228         }
 229 };
 230
 231
 232 command lastseen => {
 233         help => q(syntax: .lastseen username | Shows the number of days since the user(s) last visited irc, forum and raids),
 234         acl => 'irc_lastseen'
 235 }, class extends NDIRC::Command {
 236         method execute ($c,$msg) {
 237                 my ($username) = $msg =~ /^(\S+)$/ or die 'ARGS';
 238
 239                 my $f = $c->model->prepare(q{
 240 SELECT username, COALESCE(date_part('day',now() - laston)::text,'?') AS last
 241         ,COALESCE(date_part('day',now() - (SELECT max(time)
 242                 FROM forum_thread_visits WHERE uid = u.uid))::text,'?') AS lastforum
 243         ,COALESCE(date_part('day',now() - (SELECT max(timestamp)
 244                 FROM raid_claims WHERE uid = u.uid))::text,'?') AS lastclaim
 245 FROM users u
 246 WHERE username ILIKE $1 ORDER BY username
 247                         });
 248                 $f->execute($username);
 249
 250                 my $text;
 251                 my $i = 0;
 252                 while (my $user = $f->fetchrow_hashref){
 253                         $text .= "$user->{username}($user->{last}|$user->{lastforum}|$user->{lastclaim}) ";
 254                         $i++;
 255                 }
 256                 $c->reply("<b>$i</b> Users(days): $text");
 257         }
 258 }
 259
 260 command getships => {
 261         help => q(Usage: .getships ship | % can be used as wildcard, e.g. beet%, shipshome shows the number of ships currently home),
 262         alias => 'shipshome',
 263         acl => 'irc_getships'
 264 }, class extends NDIRC::Command {
 265         method execute ($c,$msg) {
 266                 my ($ship) = $msg =~ /^(\S+)$/ or die 'ARGS';
 267                 my $dbh = $c->model;
 268
 269                 my $f = $dbh->prepare(q{
 270 SELECT username,SUM(fs.amount) AS amount
 271 FROM users u
 272         JOIN (SELECT DISTINCT ON (pid) pid,fid FROM fleets
 273                 WHERE mission = 'Full fleet' AND name <> 'Unit'
 274                 ORDER BY pid,tick DESC,fid DESC
 275         ) f  USING (pid)
 276         JOIN fleet_ships fs USING (fid)
 277 WHERE ship ILIKE $1 AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 278 GROUP BY username ORDER BY amount DESC
 279                         });
 280                 if ($self->name eq 'shipshome'){
 281                         $f = $dbh->prepare(q{
 282 SELECT username,SUM(amount) AS amount
 283 FROM available_ships
 284 WHERE ship ILIKE ? AND uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 285 GROUP BY username ORDER BY amount DESC
 286                                 });
 287                 }
 288                 $f->execute($ship);
 289                 my $text;
 290                 my $i = 0;
 291                 my $total = 0;
 292                 while (my $user = $f->fetchrow_hashref){
 293                         $text .= "$user->{username}: $user->{amount} ";
 294                         $i++;
 295                         $total += $user->{amount};
 296                 }
 297                 if ($text){
 298                         $c->reply("<b>$i</b> Users with <b>$total $ship</b>: $text");
 299                 }else{
 300                         $c->reply("Couldn't find any user with <b>$ship</b>");
 301                 }
 302         }
 303 };
 304
 305 command getfleet => {
 306         help => q(Usage: .getfleet username | % can be used as wildcard, e.g. barr%),
 307         acl => q(irc_getfleet)
 308 }, class extends NDIRC::Command {
 309         method execute ($c,$msg) {
 310                 my ($nick) = $msg =~ /^(\S+)$/ or die 'ARGS';
 311                 my $dbh = $c->model;
 312
 313                 my $f = $dbh->prepare(q{
 314 SELECT fs.ship, fs.amount, username
 315 FROM fleet_ships fs
 316         JOIN (SELECT fid,username
 317                 FROM fleets f
 318                         JOIN users u USING (pid)
 319                 WHERE mission = 'Full fleet' AND name <> 'Unit'
 320                         AND username ILIKE $1
 321                 ORDER BY pid,tick DESC,fid DESC
 322                 LIMIT 1
 323         ) f  USING (fid)
 324 ORDER BY num
 325                         });
 326                 $f->execute($nick);
 327                 my $text;
 328                 my $username;
 329                 while (my $ship = $f->fetchrow_hashref){
 330                         unless (defined $username) {
 331                                 $username = $ship->{username};
 332                                 $text = "<b>$username</b> has: "
 333                         }
 334                         $text .= "$ship->{ship} $ship->{amount} ";
 335                 }
 336                 if ($text){
 337                         $c->reply($text);
 338                 }else{
 339                         $c->reply("Couldn't find any fleet for $nick");
 340                 }
 341         }
 342 };
 343
 344 command sethost => {
 345         help => q(Usage: .sethost username [host] | if host isn't given then it resets to netgamers host),
 346         acl => q(irc_sethost)
 347 }, class extends NDIRC::Command {
 348         method execute ($c,$msg) {
 349                 my ($nick,$host) = $msg =~ /^(\S+)(?: (\S+))?$/ or die 'ARGS';
 350                 my $dbh = $c->model;
 351
 352                 my $f = $dbh->prepare(q{
 353 SELECT uid,username,pnick,hostmask FROM users WHERE username ILIKE ?
 354                         });
 355                 $f->execute($nick);
 356                 my $user = $f->fetchrow_hashref;
 357                 if ($f->rows == 1){
 358                         $host //= "$user->{pnick}.users.netgamers.org";
 359                         eval{
 360                                 $dbh->do(q{UPDATE users SET hostmask = ? WHERE uid = ?}
 361                                         ,undef,$host,$user->{uid});
 362                                 $c->reply("Updated <b>$user->{username}</b>'s host to: <b>$host</b>");
 363                         };
 364                         if($@){
 365                                 if ($@ =~ /duplicate key value violates unique constraint/){
 366                                         my ($username, $hostname) = $dbh->selectrow_array(q{
 367 SELECT username,hostmask FROM users WHERE hostmask = $1
 368                                                 },undef,$host);
 369                                         $c->reply("<c04>Problem</c>, <b>$username</b> already uses host <b>$hostname</b>.");
 370                                 }else{
 371                                         die $@;
 372                                 }
 373                         }
 374                 }elsif ($f->rows == 0){
 375                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 376                 }else{
 377                         $c->reply("More than 1 user matched, please refine the search");
 378                 }
 379                 $f->finish;
 380         }
 381 };
 382
 383 command setpnick => {
 384         help => q(Usage: .setpnick username pnick | Changes a user's pnick),
 385         acl => q(irc_setpnick)
 386 }, class extends NDIRC::Command {
 387         method execute ($c,$msg) {
 388                 my ($nick,$pnick) = $msg =~ /^(\S+) (\S+)$/ or die 'ARGS';
 389                 my $dbh = $c->model;
 390
 391                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
 392                 $f->execute($nick);
 393                 my $user = $f->fetchrow_hashref;
 394                 if ($f->rows == 1){
 395                         my $hostname = "$pnick.users.netgamers.org";
 396                         eval{
 397                                 $dbh->do(q{UPDATE users SET pnick = ?, hostmask = ? WHERE uid = ?}
 398                                         ,undef,$pnick,$hostname,$user->{uid});
 399                                 $c->reply("Updated <b>$user->{username}</b>'s pnick to: <b>$pnick</b> and hostname to <b>$hostname</b>");
 400                         };
 401                         if($@){
 402                                 if ($@ =~ /duplicate key value violates unique constraint/){
 403                                         my ($username, $hostname, $pnick) = $dbh->selectrow_array(q{
 404 SELECT username,hostmask,pnick FROM users WHERE hostmask = $1 OR pnick = $2
 405                                                 },undef,$hostname, $pnick);
 406                                         $c->reply("<c04>Problem</c>, <b>$username</b> already uses host <b>$hostname</b> and pnick <b>$pnick</b>.");
 407                                 }else{
 408                                         die $@;
 409                                 }
 410                         }
 411                 }elsif ($f->rows == 0){
 412                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 413                 }else{
 414                         $c->reply("More than 1 user matched, please refine the search");
 415                 }
 416                 $f->finish;
 417         }
 418 };
 419
 420 my $points = class extends NDIRC::Command {
 421         has point => (
 422                 is => 'ro',
 423                 isa => 'Str',
 424                 required => 1
 425         );
 426         method execute ($c,$msg) {
 427                 my ($nick,$points) = $msg =~ /^(\S+)(?: (-?(:?\d+|\d*\.\d+)))?$/ or die 'ARGS';
 428
 429                 $points //= 1;
 430
 431                 return unless $self->check($c,$nick,$points);
 432
 433                 my $dbh = $c->model;
 434
 435                 if ($points*$points > 400){
 436                         $c->reply("Values between -20 and 20 please");
 437                         return;
 438                 }
 439
 440                 my $f = $dbh->prepare(q{SELECT uid,username FROM users WHERE username ILIKE ?});
 441                 $f->execute($nick);
 442                 my $user = $f->fetchrow_hashref;
 443                 if ($f->rows == 1){
 444                         my $type .= $self->point . "_points";
 445                         $dbh->do(qq{UPDATE users SET $type = $type + ? WHERE uid = ?}
 446                                 ,undef,$points,$user->{uid});
 447                         $c->reply("$user->{username} has been given $points $type");
 448                 }elsif ($f->rows == 0){
 449                         $c->reply("No hit, maybe spelling mistake, or add % as wildcard");
 450                 }else{
 451                         $c->reply("More than 1 user matched, please refine the search");
 452                 }
 453                 $f->finish;
 454         }
 455         method check ($c,$nick,$points) {
 456                 return 1;
 457         }
 458 };
 459
 460 command a => {
 461         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.),
 462         point => 'attack',
 463         acl => q(irc_a)
 464 }, class {
 465         extends $points->name;
 466         method check ($c,$nick,$points) {
 467                 my ($fleets) = $c->model->selectrow_array(q{
 468 SELECT count(*) FROM raids r
 469         JOIN raid_targets rt ON r.id = rt.raid
 470         JOIN raid_claims rc ON rt.id = rc.target
 471 WHERE not launched  AND tick + 24 > tick()
 472         AND uid = (SELECT uid FROM users WHERE username ILIKE $1);
 473                         },undef,$nick);
 474
 475                 if ($fleets > 0 && $points > 0){
 476                         $c->reply("$nick has $fleets claimed waves the last 24 ticks that aren't marked as launched, so no points.");
 477                         return 0;
 478                 }
 479                 return 1;
 480         }
 481 };
 482
 483 command d => {
 484         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.),
 485         acl => q(irc_d),
 486         point => 'defense',
 487         type => q(def)
 488 }, $points;
 489
 490 command s => {
 491         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.),
 492         point => 'scan',
 493         acl => q(irc_s),
 494 }, $points;
 495
 496 command h => {
 497         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.),
 498         point => 'humor',
 499         acl => q(irc_h),
 500 }, $points;
 501
 502 command getanti => {
 503         help => q(Usage: .getanti class [eta] | class is the target class, like fi or bs, eta is optional max eta for the ships.),
 504         acl => q(irc_getships),
 505 }, class extends NDIRC::Command {
 506         method execute ($c,$msg) {
 507                 my ($class,$eta) = $msg =~ /^(\S+)(?: (\d+))?$/ or die 'ARGS';
 508                 my $dbh = $c->model;
 509
 510                 $eta //= 9;
 511
 512                 my @classes = qw/Fi Co Fr De Cr Bs/;
 513                 for (@classes){
 514                         if (lc $class eq lc $_){
 515                                 $class = $_;
 516                                 last;
 517                         }
 518                 }
 519
 520                 while ($eta < 9){
 521                         pop @classes;
 522                         pop @classes;
 523                         $eta++;
 524                 }
 525
 526                 my $f = $dbh->prepare(q{
 527 SELECT username, ship, amount, CASE WHEN $1 = t1 THEN 't1' ELSE 't2' END AS t
 528 FROM available_ships a
 529         JOIN ship_stats s USING (ship)
 530 WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 'M')
 531         AND class = ANY($2)
 532         AND $1 IN (t1,t2)
 533 ORDER BY amount*(metal+crystal+eonium)*CASE WHEN $1 = t1 THEN 1.0 ELSE 0.6 END DESC
 534                         });
 535                 $f->execute($class,\@classes);
 536                 my $text;
 537                 my $i = 0;
 538                 my $total = 0;
 539                 while (my $user = $f->fetchrow_hashref){
 540                         $text .= "($user->{username}: $user->{ship} $user->{amount} $user->{t}) ";
 541                         $i++;
 542                         $total += $user->{amount};
 543                 }
 544                 if ($text){
 545                         $c->reply("<b>$i</b> fleets with anti-<b>$class</b>: $text");
 546                 }else{
 547                         $c->reply("Couldn't find any user with anti-<b>$class</b>");
 548                 }
 549         }
 550 };
 551
 552 command getpass => {
 553         help => q(Gives new users a random password.),
 554         type => q(pm)
 555 }, class extends NDIRC::Command {
 556
 557 ###########################################################
 558 # Written by Guy Malachi http://guymal.com
 559 # 18 August, 2002
 560 ###########################################################
 561         sub generate_random_string
 562         {
 563                 my $length_of_randomstring=shift;# the length of
 564                 # the random string to generate
 565
 566                 my @chars=('a'..'z','A'..'Z','0'..'9','_');
 567                 my $random_string;
 568                 foreach (1..$length_of_randomstring)
 569                 {
 570                         # rand @chars will generate a random
 571                         # number between 0 and scalar @chars
 572                         $random_string .= $chars[rand @chars];
 573                 }
 574                 return $random_string;
 575         }
 576
 577         method execute ($c,$msg) {
 578                 my $dbh = $c->model;
 579
 580                 my $password = generate_random_string 16;
 581                 my $update = $dbh->do(q{
 582 UPDATE users SET password = $1
 583 WHERE uid = $2 AND password IS NULL
 584                         },undef,$password,$c->uid);
 585                 if ($update > 0){
 586                         $c->reply("Password set to: $password (you can change it on webbie)");
 587                 }else{
 588                         $c->reply("Couldn't set password. Either it has already been set or you don't have an account");
 589                 }
 590         }
 591 };
 592
 593 1;