diff --git a/Irpg/Admin.pm b/Irpg/Admin.pm
index 08a3c10ef43f64d16e149939d18e82a8d2efecd8..9a34ff308bc33d2a5af498c84cbb1a41fee1c27c 100644
--- a/Irpg/Admin.pm
+++ b/Irpg/Admin.pm
@@ -10,279 +10,279 @@ use Irpg::Event qw(hog);
my $opts;
my $rps;
=head1 FUNCTION init_hashes
- This function sets the references to
- options and players hashes.
+ This function sets the references to
+ options and players hashes.
=over
-=item SCALAR (ref) - reference to the options hash
-=item SCALAR (ref) - reference to the players hash
+=item SCALAR (ref) - reference to the options hash
+=item SCALAR (ref) - reference to the players hash
=cut
sub init_pkg { ($opts, $rps) = @_; }
sub join_chans {
- for (@_[3..$#_]) {
- Irpg::Irc::sts("JOIN $_");
- }
+ for (@_[3..$#_]) {
+ Irpg::Irc::sts("JOIN $_");
+ }
}
sub leave_chans {
- for (@_[3..$#_]) {
- Irpg::Irc::sts("PART $_");
- }
+ for (@_[3..$#_]) {
+ Irpg::Irc::sts("PART $_");
+ }
}
sub peval {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if ($opts->{ownerpevalonly} && $opts->{owner} ne $usernick) {
- Irpg::Irc::privmsg("You don't have access to PEVAL.", $usernick);
- }
- else {
- my (undef) = $rps; #does nothing;
- #this is a cheat to have $rps variable
- #available in eval context
- #FIXME
- #I don't understand why $rps is not already available
- my @peval = eval "@arg";
- if (@peval >= 4 || length("@peval") > 1024) {
- Irpg::Irc::privmsg("Command produced too much output to send ".
- "outright; queueing ".length("@peval").
- " bytes in ".scalar(@peval)." items. Use ".
- "CLEARQ to clear queue if needed.",$usernick,1);
- Irpg::Irc::privmsg($_,$usernick) for @peval;
- }
- else { Irpg::Irc::privmsg($_,$usernick, 1) for @peval; }
- Irpg::Irc::privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if ($opts->{ownerpevalonly} && $opts->{owner} ne $usernick) {
+ Irpg::Irc::privmsg("You don't have access to PEVAL.", $usernick);
+ }
+ else {
+ my (undef) = $rps; #does nothing;
+ #this is a cheat to have $rps variable
+ #available in eval context
+ #FIXME
+ #I don't understand why $rps is not already available
+ my @peval = eval "@arg";
+ if (@peval >= 4 || length("@peval") > 1024) {
+ Irpg::Irc::privmsg("Command produced too much output to send ".
+ "outright; queueing ".length("@peval").
+ " bytes in ".scalar(@peval)." items. Use ".
+ "CLEARQ to clear queue if needed.",$usernick,1);
+ Irpg::Irc::privmsg($_,$usernick) for @peval;
+ }
+ else { Irpg::Irc::privmsg($_,$usernick, 1) for @peval; }
+ Irpg::Irc::privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
+ }
}
sub delold {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if ($arg[0] !~ /^[\d\.]+$/) {
- Irpg::Irc::privmsg("Try: DELOLD <# of days>", $usernick, 1);
- }
- else {
- my @oldaccounts = grep { (time()-$rps->{$_}{lastlogin}) >
- ($arg[0] * 86400) &&
- !$rps->{$_}{online} } keys(%$rps);
- delete(@$rps->{@oldaccounts});
- Irpg::Irc::chanmsg(scalar(@oldaccounts)." accounts not accessed in ".
- "the last $arg[0] days removed by $usernick.");
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if ($arg[0] !~ /^[\d\.]+$/) {
+ Irpg::Irc::privmsg("Try: DELOLD <# of days>", $usernick, 1);
+ }
+ else {
+ my @oldaccounts = grep { (time()-$rps->{$_}{lastlogin}) >
+ ($arg[0] * 86400) &&
+ !$rps->{$_}{online} } keys(%$rps);
+ delete(@$rps->{@oldaccounts});
+ Irpg::Irc::chanmsg(scalar(@oldaccounts)." accounts not accessed in ".
+ "the last $arg[0] days removed by $usernick.");
+ }
}
sub delacct {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if (!defined($arg[0])) {
- Irpg::Irc::privmsg("Try: DEL <char name>", $usernick, 1);
- }
- elsif (!exists($rps->{$arg[0]})) {
- Irpg::Irc::privmsg("No such account $arg[0].", $usernick, 1);
- }
- else {
- delete($rps->{$arg[0]});
- Irpg::Irc::chanmsg("Account $arg[0] removed by $usernick.");
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if (!defined($arg[0])) {
+ Irpg::Irc::privmsg("Try: DEL <char name>", $usernick, 1);
+ }
+ elsif (!exists($rps->{$arg[0]})) {
+ Irpg::Irc::privmsg("No such account $arg[0].", $usernick, 1);
+ }
+ else {
+ delete($rps->{$arg[0]});
+ Irpg::Irc::chanmsg("Account $arg[0] removed by $usernick.");
+ }
}
sub mkadmin {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if ($opts->{owneraddonly} && $opts->{owner} ne $usernick) {
- Irpg::Irc::privmsg("You don't have access to MKADMIN.", $usernick);
- }
- elsif (!defined($arg[0])) {
- Irpg::Irc::privmsg("Try: MKADMIN <char name>", $usernick, 1);
- }
- elsif (!exists($rps->{$arg[0]})) {
- Irpg::Irc::privmsg("No such account $arg[0].", $usernick, 1);
- }
- else {
- $rps->{$arg[0]}{isadmin}=1;
- Irpg::Irc::privmsg("Account $arg[0] is now a bot admin.",$usernick, 1);
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if ($opts->{owneraddonly} && $opts->{owner} ne $usernick) {
+ Irpg::Irc::privmsg("You don't have access to MKADMIN.", $usernick);
+ }
+ elsif (!defined($arg[0])) {
+ Irpg::Irc::privmsg("Try: MKADMIN <char name>", $usernick, 1);
+ }
+ elsif (!exists($rps->{$arg[0]})) {
+ Irpg::Irc::privmsg("No such account $arg[0].", $usernick, 1);
+ }
+ else {
+ $rps->{$arg[0]}{isadmin}=1;
+ Irpg::Irc::privmsg("Account $arg[0] is now a bot admin.",$usernick, 1);
+ }
}
sub rmadmin {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if ($opts->{ownerdelonly} && $opts->{owner} ne $usernick) {
- Irpg::Irc::privmsg("You don't have access to RMADMIN.", $usernick);
- }
- elsif (!defined($arg[0])) {
- Irpg::Irc::privmsg("Try: RMADMIN <char name>", $usernick, 1);
- }
- elsif (!exists($rps->{$arg[0]})) {
- Irpg::Irc::privmsg("No such account $arg[0].", $usernick, 1);
- }
- elsif ($arg[0] eq $opts->{owner}) {
- Irpg::Irc::privmsg("Cannot RMADMIN owner account.", $usernick, 1);
- }
- else {
- $rps->{$arg[0]}{isadmin}=0;
- Irpg::Irc::privmsg("Account $arg[0] is no longer a bot admin.",
- $usernick, 1);
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if ($opts->{ownerdelonly} && $opts->{owner} ne $usernick) {
+ Irpg::Irc::privmsg("You don't have access to RMADMIN.", $usernick);
+ }
+ elsif (!defined($arg[0])) {
+ Irpg::Irc::privmsg("Try: RMADMIN <char name>", $usernick, 1);
+ }
+ elsif (!exists($rps->{$arg[0]})) {
+ Irpg::Irc::privmsg("No such account $arg[0].", $usernick, 1);
+ }
+ elsif ($arg[0] eq $opts->{owner}) {
+ Irpg::Irc::privmsg("Cannot RMADMIN owner account.", $usernick, 1);
+ }
+ else {
+ $rps->{$arg[0]}{isadmin}=0;
+ Irpg::Irc::privmsg("Account $arg[0] is no longer a bot admin.",
+ $usernick, 1);
+ }
}
sub rehash {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- $opts = readconfig();
- Irpg::Irc::privmsg("Reread config file.",$usernick,1);
- $opts->{botchan} =~ s/ .*//; # strip channel key if present
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ $opts = readconfig();
+ Irpg::Irc::privmsg("Reread config file.",$usernick,1);
+ $opts->{botchan} =~ s/ .*//; # strip channel key if present
}
sub chpass {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if (!defined($arg[1])) {
- Irpg::Irc::privmsg("Try: CHPASS <char name> <new pass>", $usernick, 1);
- }
- elsif (!exists($rps->{$arg[0]})) {
- Irpg::Irc::privmsg("No such username $arg[0].", $usernick, 1);
- }
- else {
- $rps->{$arg[0]}{pass} = crypt($arg[1],mksalt());
- Irpg::Irc::privmsg("Password for $arg[0] changed.", $usernick, 1);
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if (!defined($arg[1])) {
+ Irpg::Irc::privmsg("Try: CHPASS <char name> <new pass>", $usernick, 1);
+ }
+ elsif (!exists($rps->{$arg[0]})) {
+ Irpg::Irc::privmsg("No such username $arg[0].", $usernick, 1);
+ }
+ else {
+ $rps->{$arg[0]}{pass} = crypt($arg[1],mksalt());
+ Irpg::Irc::privmsg("Password for $arg[0] changed.", $usernick, 1);
+ }
}
sub chuser {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- if (!defined($arg[1])) {
- Irpg::Irc::privmsg("Try: CHUSER <char name> <new char name>",
- $usernick, 1);
- }
- elsif (!exists($rps->{$arg[0]})) {
- Irpg::Irc::privmsg("No such username $arg[0].", $usernick, 1);
- }
- elsif (exists($rps->{$arg[1]})) {
- Irpg::Irc::privmsg("Username $arg[1] is already taken.", $usernick,1);
- }
- else {
- $rps->{$arg[1]} = delete($rps->{$arg[0]});
- Irpg::Irc::privmsg("Username for $arg[0] changed to $arg[1].",
- $usernick, 1);
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ if (!defined($arg[1])) {
+ Irpg::Irc::privmsg("Try: CHUSER <char name> <new char name>",
+ $usernick, 1);
+ }
+ elsif (!exists($rps->{$arg[0]})) {
+ Irpg::Irc::privmsg("No such username $arg[0].", $usernick, 1);
+ }
+ elsif (exists($rps->{$arg[1]})) {
+ Irpg::Irc::privmsg("Username $arg[1] is already taken.", $usernick,1);
+ }
+ else {
+ $rps->{$arg[1]} = delete($rps->{$arg[0]});
+ Irpg::Irc::privmsg("Username for $arg[0] changed to $arg[1].",
+ $usernick, 1);
+ }
}
sub push {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- # insure it's a positive or negative, integral number of seconds
- if ($arg[1] !~ /^\-?\d+$/) {
- Irpg::Irc::privmsg("Try: PUSH <char name> <seconds>", $usernick, 1);
- }
- elsif (!exists($rps->{$arg[0]})) {
- Irpg::Irc::privmsg("No such username $arg[0].", $usernick, 1);
- }
- elsif ($arg[1] > $rps->{$arg[0]}{next}) {
- Irpg::Irc::privmsg("Time to level for $arg[0] ($rps->{$arg[0]}{next}s) ".
- "is lower than $arg[1]; setting TTL to 0.",
- $usernick, 1);
- Irpg::Irc::chanmsg("$usernick has pushed $arg[0] ".
- duration($rps->{$arg[0]}{next}).
- " ($rps->{$arg[0]}{next} seconds) ".
- "toward level ".($rps->{$arg[0]}{level}+1));
- $rps->{$arg[0]}{next}=0;
- }
- else {
- $rps->{$arg[0]}{next} -= $arg[1];
- Irpg::Irc::chanmsg("$usernick has pushed $arg[0] ".
- duration($arg[1])." ($arg[1] seconds) ".
- "toward level ".($rps->{$arg[0]}{level}+1).". ".
- "$arg[0] reaches next level in ".
- duration($rps->{$arg[0]}{next}).".");
- }
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ # insure it's a positive or negative, integral number of seconds
+ if ($arg[1] !~ /^\-?\d+$/) {
+ Irpg::Irc::privmsg("Try: PUSH <char name> <seconds>", $usernick, 1);
+ }
+ elsif (!exists($rps->{$arg[0]})) {
+ Irpg::Irc::privmsg("No such username $arg[0].", $usernick, 1);
+ }
+ elsif ($arg[1] > $rps->{$arg[0]}{next}) {
+ Irpg::Irc::privmsg("Time to level for $arg[0] ($rps->{$arg[0]}{next}s) ".
+ "is lower than $arg[1]; setting TTL to 0.",
+ $usernick, 1);
+ Irpg::Irc::chanmsg("$usernick has pushed $arg[0] ".
+ duration($rps->{$arg[0]}{next}).
+ " ($rps->{$arg[0]}{next} seconds) ".
+ "toward level ".($rps->{$arg[0]}{level}+1));
+ $rps->{$arg[0]}{next}=0;
+ }
+ else {
+ $rps->{$arg[0]}{next} -= $arg[1];
+ Irpg::Irc::chanmsg("$usernick has pushed $arg[0] ".
+ duration($arg[1])." ($arg[1] seconds) ".
+ "toward level ".($rps->{$arg[0]}{level}+1).". ".
+ "$arg[0] reaches next level in ".
+ duration($rps->{$arg[0]}{next}).".");
+ }
}
sub bot_die {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- $opts->{reconnect} = 0;
- writedb($rps);
- Irpg::Irc::sts("QUIT :DIE from $usernick",1);
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ $opts->{reconnect} = 0;
+ writedb($rps);
+ Irpg::Irc::sts("QUIT :DIE from $usernick",1);
}
sub restart {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- writedb($rps);
- Irpg::Irc::sts("QUIT :RESTART from $usernick",1);
- #close($Irpg::Irc::sock);
- #Irpg::Irc::irc_clean($opts);
- exec("perl $0");
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ writedb($rps);
+ Irpg::Irc::sts("QUIT :RESTART from $usernick",1);
+ #close($Irpg::Irc::sock);
+ #Irpg::Irc::irc_clean($opts);
+ exec("perl $0");
}
sub do_backup {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- backup();
- Irpg::Irc::privmsg("$opts->{dbfile} copied to ".
- ".dbbackup/$opts->{dbfile}".time(),$usernick,1);
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ backup();
+ Irpg::Irc::privmsg("$opts->{dbfile} copied to ".
+ ".dbbackup/$opts->{dbfile}".time(),$usernick,1);
}
sub clearq {
- my ($userhost, $usernick, $username, $source, @arg) = @_;
- undef(@Irpg::Irc::queue);
- Irpg::Irc::chanmsg("Outgoing message queue cleared by $usernick.");
- Irpg::Irc::privmsg("Outgoing message queue cleared.",$usernick,1);
+ my ($userhost, $usernick, $username, $source, @arg) = @_;
+ undef(@Irpg::Irc::queue);
+ Irpg::Irc::chanmsg("Outgoing message queue cleared by $usernick.");
+ Irpg::Irc::privmsg("Outgoing message queue cleared.",$usernick,1);
}
sub dump_rps {
- use Data::Dumper;
- print Dumper($rps);
+ use Data::Dumper;
+ print Dumper($rps);
}
our $commands = {
- dumprps => {ref => \&dump_rps, adm => 1, prv => 1, pub => 0,
- hlp => 'DUMPRPS : dump the current state of %rps'},
+ dumprps => {ref => \&dump_rps, adm => 1, prv => 1, pub => 0,
+ hlp => 'DUMPRPS : dump the current state of %rps'},
- go => {ref => \&join_chans, adm => 1, prv => 1, pub => 0,
- hlp => 'GO <chan>[ <chan> ...] : join the given chan(s)'},
+ go => {ref => \&join_chans, adm => 1, prv => 1, pub => 0,
+ hlp => 'GO <chan>[ <chan> ...] : join the given chan(s)'},
- leave => {ref => \&leave_chans,adm => 1, prv => 1, pub => 0,
- hlp => 'LEAVE <chan>[ <chan> ...] : join the given chan(s)'},
+ leave => {ref => \&leave_chans,adm => 1, prv => 1, pub => 0,
+ hlp => 'LEAVE <chan>[ <chan> ...] : join the given chan(s)'},
- peval => {ref => \&peval, adm => 1, prv => 1, pub => 0,
- hlp => 'PEVAL <code> : execute arbitrary argument as Perl code. '.
- 'Queues output > 3 lines or >1k of text.'},
+ peval => {ref => \&peval, adm => 1, prv => 1, pub => 0,
+ hlp => 'PEVAL <code> : execute arbitrary argument as Perl code. '.
+ 'Queues output > 3 lines or >1k of text.'},
- delold => {ref => \&delold, adm => 1, prv => 1, pub => 0,
- hlp => 'DELOLD <nday> : remove all non-logged-in accounts '.
- 'inactive in the last <nday> days'},
+ delold => {ref => \&delold, adm => 1, prv => 1, pub => 0,
+ hlp => 'DELOLD <nday> : remove all non-logged-in accounts '.
+ 'inactive in the last <nday> days'},
- del => {ref => \&delacct, adm => 1, prv => 1, pub => 0,
- hlp => ''},
+ del => {ref => \&delacct, adm => 1, prv => 1, pub => 0,
+ hlp => ''},
- mkadmin => {ref => \&mkadmin, adm => 1, prv => 1, pub => 0,
- hlp => 'MKADMIN <username> : set the isadmin flag '.
- 'for a given <username>'},
+ mkadmin => {ref => \&mkadmin, adm => 1, prv => 1, pub => 0,
+ hlp => 'MKADMIN <username> : set the isadmin flag '.
+ 'for a given <username>'},
- rmadmin => {ref => \&rmadmin, adm => 1, prv => 1, pub => 0,
- hlp => 'MKADMIN <username> : remove the isadmin flag '.
- 'for a given <username>'},
+ rmadmin => {ref => \&rmadmin, adm => 1, prv => 1, pub => 0,
+ hlp => 'MKADMIN <username> : remove the isadmin flag '.
+ 'for a given <username>'},
- rehash => {ref => \&rehash, adm => 1, prv => 1, pub => 0,
- hlp => 'REHASH : reload configuration file.'},
+ rehash => {ref => \&rehash, adm => 1, prv => 1, pub => 0,
+ hlp => 'REHASH : reload configuration file.'},
- chpass => {ref => \&chpass, adm => 1, prv => 1, pub => 0,
- hlp => 'CHPASS <char name> <new password> :'.
- 'change a character\'s password.'},
+ chpass => {ref => \&chpass, adm => 1, prv => 1, pub => 0,
+ hlp => 'CHPASS <char name> <new password> :'.
+ 'change a character\'s password.'},
- chuser => {ref => \&chuser, adm => 1, prv => 1, pub => 0,
- hlp => 'CHUSER <char name> <new char name> :'.
- 'change a character\'s name.'},
+ chuser => {ref => \&chuser, adm => 1, prv => 1, pub => 0,
+ hlp => 'CHUSER <char name> <new char name> :'.
+ 'change a character\'s name.'},
- push => {ref => \&push, adm => 1, prv => 1, pub => 0,
- hlp => 'PUSH <char name> <seconds> : '.
- 'remove <seconds> to a player\'s TTL. '.
- 'Can be a negative number to add TTL.'},
+ push => {ref => \&push, adm => 1, prv => 1, pub => 0,
+ hlp => 'PUSH <char name> <seconds> : '.
+ 'remove <seconds> to a player\'s TTL. '.
+ 'Can be a negative number to add TTL.'},
- die => {ref => \&bot_die, adm => 1, prv => 1, pub => 0,
- hlp => 'DIE : kills the bot.'},
+ die => {ref => \&bot_die, adm => 1, prv => 1, pub => 0,
+ hlp => 'DIE : kills the bot.'},
- restart => {ref => \&restart, adm => 1, prv => 1, pub => 0,
- hlp => 'RESTART : restarts the bot.'},
+ restart => {ref => \&restart, adm => 1, prv => 1, pub => 0,
+ hlp => 'RESTART : restarts the bot.'},
- backup => {ref => \&do_backup, adm => 1, prv => 1, pub => 0,
- hlp => 'BACKUP : make a backup copy of the dbfile.'},
+ backup => {ref => \&do_backup, adm => 1, prv => 1, pub => 0,
+ hlp => 'BACKUP : make a backup copy of the dbfile.'},
- clearq => {ref => \&clearq, adm => 1, prv => 1, pub => 0,
- hlp => 'CLEARQ : clear the outgoing message queue. '.
- 'Useful if the bot is flooded (and plans to respond). '}
+ clearq => {ref => \&clearq, adm => 1, prv => 1, pub => 0,
+ hlp => 'CLEARQ : clear the outgoing message queue. '.
+ 'Useful if the bot is flooded (and plans to respond). '}
};
1;