GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-26 05:49:27 +01:00
Code Issues Projects Releases Wiki Activity

Half-way through converting everything to objects. Committing mostly working copy as preview.

Browse Source
This commit is contained in:
Pragmatic Software 2010-03-22 07:33:44 +00:00
parent f725743ccb
commit bd46c11120
38 changed files with 2953 additions and 2035 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
PBot/AntiFlood.pm
View File

@ -1,7 +1,9 @@
# File: NewModule.pm
# File: AntiFlood.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
# Purpose: Keeps track of which nick has said what and when. Used in
# conjunction with OperatorStuff and Quotegrabs for kick/quiet on flood
# and grabbing quotes, respectively.
package PBot::AntiFlood;
@ -9,100 +11,113 @@ use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($logger $botnick %flood_watch $MAX_NICK_MESSAGES $FLOOD_CHAT $conn $last_timestamp $flood_msg
%channels);
}
use vars @EXPORT_OK;
use Time::HiRes qw(gettimeofday);
use Carp ();
*logger = \$PBot::PBot::logger;
*botnick = \$PBot::PBot::botnick;
*conn = \$PBot::PBot::conn;
*MAX_NICK_MESSAGES = \$PBot::PBot::MAX_NICK_MESSAGES;
*channels = \%PBot::ChannelStuff::channels;
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to AntiFlood should be key/value pairs, not hash reference");
}
# do not modify
$FLOOD_CHAT = 0;
#$FLOOD_JOIN = 1; # currently unused -- todo?
my ($class, %conf) = @_;
$last_timestamp = gettimeofday;
$flood_msg = 0;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
%flood_watch = ();
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to AntiFlood");
}
$self->{pbot} = $pbot;
$self->{FLOOD_CHAT} = 0;
$self->{FLOOD_JOIN} = 1;
$self->{flood_msg_count} = 0;
$self->{last_timestamp} = gettimeofday;
$self->{message_history} = {};
}
sub check_flood {
my ($channel, $nick, $user, $host, $text, $max, $mode) = @_;
my ($self, $channel, $nick, $user, $host, $text, $max, $mode) = @_;
my $now = gettimeofday;
$channel = lc $channel;
$logger->log(sprintf("check flood %-48s %-16s %s\n", "$nick!$user\@$host", "[$channel]", $text));
$self->{pbot}->logger->log(sprintf("check flood %-48s %-16s <%10s> %s\n", "$nick!$user\@$host", "[$channel]", , $nick, $text));
return if $nick eq $botnick;
return if $nick eq $self->{pbot}->botnick;
if(exists $flood_watch{$nick}) {
#$logger->log("nick exists\n");
if(exists ${ $self->message_history }{$nick}) {
#$self->{pbot}->logger->log("nick exists\n");
if(not exists $flood_watch{$nick}{$channel}) {
#$logger->log("adding new channel for existing nick\n");
$flood_watch{$nick}{$channel}{offenses} = 0;
$flood_watch{$nick}{$channel}{messages} = [];
if(not exists ${ $self->message_history }{$nick}{$channel}) {
#$self->{pbot}->logger->log("adding new channel for existing nick\n");
${ $self->message_history }{$nick}{$channel}{offenses} = 0;
${ $self->message_history }{$nick}{$channel}{messages} = [];
}
#$logger->log("appending new message\n");
#$self->{pbot}->logger->log("appending new message\n");
push(@{ $flood_watch{$nick}{$channel}{messages} }, { timestamp => $now, msg => $text, mode => $mode });
push(@{ ${ $self->message_history }{$nick}{$channel}{messages} }, { timestamp => $now, msg => $text, mode => $mode });
my $length = $#{ $flood_watch{$nick}{$channel}{messages} } + 1;
my $length = $#{ ${ $self->message_history }{$nick}{$channel}{messages} } + 1;
#$logger->log("length: $length, max nick messages: $MAX_NICK_MESSAGES\n");
#$self->{pbot}->logger->log("length: $length, max nick messages: $MAX_NICK_MESSAGES\n");
if($length >= $MAX_NICK_MESSAGES) {
my %msg = %{ shift(@{ $flood_watch{$nick}{$channel}{messages} }) };
#$logger->log("shifting message off top: $msg{msg}, $msg{timestamp}\n");
if($length >= $self->{pbot}->{MAX_NICK_MESSAGES}) {
my %msg = %{ shift(@{ ${ $self->message_history }{$nick}{$channel}{messages} }) };
#$self->{pbot}->logger->log("shifting message off top: $msg{msg}, $msg{timestamp}\n");
$length--;
}
return if not exists $channels{$channel} or $channels{$channel}{is_op} == 0;
return if not exists ${ $self->{pbot}->channels }{$channel} or ${ $self->{pbot}->channels }{$channel}{is_op} == 0;
#$logger->log("length: $length, max: $max\n");
#$self->{pbot}->logger->log("length: $length, max: $max\n");
if($length >= $max) {
# $logger->log("More than $max messages spoken, comparing time differences\n");
my %msg = %{ @{ $flood_watch{$nick}{$channel}{messages} }[$length - $max] };
my %last = %{ @{ $flood_watch{$nick}{$channel}{messages} }[$length - 1] };
# $self->{pbot}->logger->log("More than $max messages spoken, comparing time differences\n");
my %msg = %{ @{ ${ $self->message_history }{$nick}{$channel}{messages} }[$length - $max] };
my %last = %{ @{ ${ $self->message_history }{$nick}{$channel}{messages} }[$length - 1] };
#$logger->log("Comparing $last{timestamp} against $msg{timestamp}: " . ($last{timestamp} - $msg{timestamp}) . " seconds\n");
#$self->{pbot}->logger->log("Comparing $last{timestamp} against $msg{timestamp}: " . ($last{timestamp} - $msg{timestamp}) . " seconds\n");
if($last{timestamp} - $msg{timestamp} <= 10 && not PBot::BotAdminStuff::loggedin($nick, $host)) {
$flood_watch{$nick}{$channel}{offenses}++;
my $length = $flood_watch{$nick}{$channel}{offenses} * $flood_watch{$nick}{$channel}{offenses} * 30;
if($last{timestamp} - $msg{timestamp} <= 10 && not $self->{pbot}->admins->loggedin($channel, "$nick!$user\@$host")) {
${ $self->message_history }{$nick}{$channel}{offenses}++;
my $length = ${ $self->message_history }{$nick}{$channel}{offenses} * ${ $self->message_history }{$nick}{$channel}{offenses} * 30;
if($channel =~ /^#/) { #channel flood (opposed to private message or otherwise)
if($mode == $FLOOD_CHAT) {
PBot::OperatorStuff::quiet_nick_timed($nick, $channel, $length);
$conn->privmsg($nick, "You have been quieted due to flooding. Please use a web paste service such as http://codepad.org for lengthy pastes. You will be allowed to speak again in $length seconds.");
$logger->log("$nick $channel flood offense $flood_watch{$nick}{$channel}{offenses} earned $length second quiet\n");
if($mode == $self->{FLOOD_CHAT}) {
# PBot::OperatorStuff::quiet_nick_timed($nick, $channel, $length);
$self->{pbot}->conn->privmsg($nick, "You have been quieted due to flooding. Please use a web paste service such as http://codepad.org for lengthy pastes. You will be allowed to speak again in $length seconds.");
$self->{pbot}->logger->log("$nick $channel flood offense ${ $self->message_history }{$nick}{$channel}{offenses} earned $length second quiet\n");
}
} else { # private message flood
$logger->log("$nick msg flood offense $flood_watch{$nick}{$channel}{offenses} earned $length second ignore\n");
PBot::IgnoreList::ignore_user("", "floodcontrol", "", "$nick" . '@' . "$host $channel $length");
$self->{pbot}->logger->log("$nick msg flood offense ${ $self->message_history }{$nick}{$channel}{offenses} earned $length second ignore\n");
$self->{pbot}->ignorelist->ignore_user("", "floodcontrol", "", "$nick" . '@' . "$host $channel $length");
}
}
}
} else {
#$logger->log("brand new nick addition\n");
#$self->{pbot}->logger->log("brand new nick addition\n");
# new addition
$flood_watch{$nick}{$channel}{offenses} = 0;
$flood_watch{$nick}{$channel}{messages} = [];
push(@{ $flood_watch{$nick}{$channel}{messages} }, { timestamp => $now, msg => $text, mode => $mode });
${ $self->message_history }{$nick}{$channel}{offenses} = 0;
${ $self->message_history }{$nick}{$channel}{messages} = [];
push(@{ ${ $self->message_history }{$nick}{$channel}{messages} }, { timestamp => $now, msg => $text, mode => $mode });
}
}
sub message_history {
my $self = shift;
return $self->{message_history};
}
1;

134
PBot/BotAdminCommands.pm Normal file
View File

@ -0,0 +1,134 @@
# File: BotAdminCommands.pm
# Authoer: pragma_
#
# Purpose: Administrative command subroutines.
package PBot::BotAdminCommands;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
}
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to BotAdminCommands should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to BotAdminCommands");
}
$self->{pbot} = $pbot;
$pbot->commands->register(sub { return $self->login(@_) }, "login", 0);
$pbot->commands->register(sub { return $self->logout(@_) }, "logout", 0);
$pbot->commands->register(sub { return $self->join_channel(@_) }, "join", 45);
$pbot->commands->register(sub { return $self->part_channel(@_) }, "part", 45);
$pbot->commands->register(sub { return $self->ack_die(@_) }, "die", 50);
$pbot->commands->register(sub { return $self->add_admin(@_) }, "addadmin", 60);
}
sub login {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
if($self->{pbot}->admins->loggedin($from, "$nick!$user\@$host")) {
return "/msg $nick You are already logged in.";
}
my $result = $self->{pbot}->admins->login($from, "$nick!$user\@$host", $arguments);
return "/msg $nick $result";
}
sub logout {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Uh, you aren't logged in." if(not $self->{pbot}->admins->loggedin($from, "$nick!$user\@$host"));
$self->{pbot}->admins->logout($from, "$nick!$user\@$host");
return "/msg $nick Good-bye, $nick.";
}
sub add_admin {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Coming soon.";
}
sub del_admin {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Coming soon.";
}
sub join_channel {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
# FIXME -- update %channels hash?
$self->{pbot}->logger->log("$nick!$user\@$host made me join $arguments\n");
$self->{pbot}->conn->join($arguments);
return "/msg $nick Joined $arguments";
}
sub part_channel {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
# FIXME -- update %channels hash?
$self->{pbot}->logger->log("$nick!$user\@$host made me part $arguments\n");
$self->{pbot}->conn->part($arguments);
return "/msg $nick Parted $arguments";
}
sub ack_die {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
$self->{pbot}->logger->log("$nick!$user\@$host made me exit.\n");
$self->{pbot}->factoids->save_factoids();
$self->{pbot}->conn->privmsg($from, "Good-bye.") if defined $from;
$self->{pbot}->conn->quit("Departure requested.");
exit 0;
}
sub export {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: export <modules|factoids|admins>";
}
if($arguments =~ /^modules$/i) {
return "/msg $nick Coming soon.";
}
if($arguments =~ /^quotegrabs$/i) {
return PBot::Quotegrabs::export_quotegrabs();
}
if($arguments =~ /^factoids$/i) {
return PBot::Factoids::export_factoids();
}
if($arguments =~ /^admins$/i) {
return "/msg $nick Coming soon.";
}
}
1;

41
PBot/BotAdminStuff.pm
View File

@ -1,41 +0,0 @@
# File: NewModule.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
package PBot::BotAdminStuff;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw(%admins);
}
use vars @EXPORT_OK;
%admins = ();
sub loggedin {
my ($nick, $host) = @_;
if(exists $admins{$nick} && $host =~ /$admins{$nick}{host}/
&& exists $admins{$nick}{login}) {
return 1;
} else {
return 0;
}
}
sub load_admins {
}
sub save_admins {
}
1;

239
PBot/BotAdmins.pm Normal file
View File

@ -0,0 +1,239 @@
# File: BotAdmins.pm
# Authoer: pragma_
#
# Purpose: Manages list of bot admins and whether they are logged in.
package PBot::BotAdmins;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
}
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to BotAdmins should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $filename = delete $conf{filename};
my $export_path = delete $conf{export_path};
my $export_site = delete $conf{export_site};
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to BotAdmins");
}
my $export_timeout = delete $conf{export_timeout};
if(not defined $export_timeout) {
if(defined $export_path) {
$export_timeout = 300; # every 5 minutes
} else {
$export_timeout = -1;
}
}
$self->{admins} = {};
$self->{filename} = $filename;
$self->{export_path} = $export_path;
$self->{export_site} = $export_site;
$self->{export_timeout} = $export_timeout;
$self->{pbot} = $pbot;
}
sub add_admin {
my $self = shift;
my ($channel, $hostmask, $level, $password) = @_;
$channel = lc $channel;
$hostmask = lc $hostmask;
$channel =~ s/\*/.*/g;
$hostmask =~ s/\*/.*/g;
${ $self->admins}{$channel}{$hostmask}{level} = $level;
${ $self->admins}{$channel}{$hostmask}{password} = $password;
$self->{pbot}->logger->log("Adding new level $level admin: [$hostmask]\n");
}
sub remove_admin {
my $self = shift;
my ($channel, $hostmask) = @_;
delete ${ $self->admins }{$channel}{$hostmask};
}
sub load_admins {
my $self = shift;
my $filename;
if(@_) { $filename = shift; } else { $filename = $self->filename; }
if(not defined $filename) {
Carp::carp "No admins path specified -- skipping loading of admins";
return;
}
$self->{pbot}->logger->log("Loading admins from $filename ...\n");
open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n";
my @contents = <FILE>;
close(FILE);
my $i = 0;
foreach my $line (@contents) {
chomp $line;
$i++;
my ($channel, $hostmask, $level, $password) = split(/\s+/, $line, 4);
if(not defined $channel || not defined $hostmask || not defined $level || not defined $password) {
Carp::croak "Syntax error around line $i of $filename\n";
}
$self->add_admin($channel, $hostmask, $level, $password);
}
$self->{pbot}->logger->log(" $i admins loaded.\n");
$self->{pbot}->logger->log("Done.\n");
}
sub save_admins {
my $self = shift;
my $filename;
if(@_) { $filename = shift; } else { $filename = $self->filename; }
if(not defined $filename) {
Carp::carp "No admins path specified -- skipping saving of admins\n";
return;
}
}
sub export_admins {
my $self = shift;
my $filename;
if(@_) { $filename = shift; } else { $filename = $self->export_path; }
return if not defined $filename;
return;
}
sub interpreter {
my $self = shift;
my ($from, $nick, $user, $host, $count, $keyword, $arguments, $tonick) = @_;
my $result;
my $pbot = $self->{pbot};
return undef;
}
sub export_path {
my $self = shift;
if(@_) { $self->{export_path} = shift; }
return $self->{export_path};
}
sub export_timeout {
my $self = shift;
if(@_) { $self->{export_timeout} = shift; }
return $self->{export_timeout};
}
sub logger {
my $self = shift;
if(@_) { $self->{logger} = shift; }
return $self->{logger};
}
sub export_site {
my $self = shift;
if(@_) { $self->{export_site} = shift; }
return $self->{export_site};
}
sub admins {
my $self = shift;
return $self->{admins};
}
sub filename {
my $self = shift;
if(@_) { $self->{filename} = shift; }
return $self->{filename};
}
sub loggedin {
my ($self, $channel, $hostmask) = @_;
$channel = '*' if not defined $channel;
$channel =~ s/\*/.*/g;
$hostmask =~ s/\*/.*/g;
if(exists ${ $self->{admins} }{$channel}{$hostmask}{loggedin}) {
return { hostmask => $hostmask, level => ${ $self->{admins} }{$channel}{$hostmask}{level} };
} else {
return undef;
}
}
sub login {
my ($self, $channel, $hostmask, $password) = @_;
$channel = '*' if not defined $channel;
$channel =~ s/\*/.*/g;
$hostmask =~ s/\*/.*/g;
if((not exists ${ $self->{admins}}{$channel}) && (not exists ${ $self->{admins}}{$channel}{$hostmask})) {
$self->{pbot}->logger->log("Attempt to login non-existent [$channel][$hostmask] failed\n");
return "You do not have an account.";
}
if(${ $self->{admins} }{$channel}{$hostmask}{password} ne $password) {
$self->{pbot}->logger->log("Bad login password for [$channel][$hostmask]\n");
return "I don't think so.";
}
${ $self->{admins}}{$channel}{$hostmask}{loggedin} = 1;
$self->{pbot}->logger->log("$hostmask logged-in in $channel\n");
return "Logged in.";
}
sub logout {
my ($self, $channel, $hostmask) = @_;
$channel = '*' if not defined $channel;
$channel =~ s/\*/.*/g;
$hostmask =~ s/\*/.*/g;
delete ${ $self->{admins} }{$channel}{$hostmask}{loggedin};
}
1;

242
PBot/ChanOps.pm Normal file
View File

@ -0,0 +1,242 @@
# File: ChanOps.pm
# Authoer: pragma_
#
# Purpose: Provides channel operator status tracking and commands.
package PBot::ChanOps;
use warnings;
use strict;
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
use Time::HiRes qw(gettimeofday);
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to ChanOps should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to ChanOps");
}
$self->{pbot} = $pbot;
$self->{quieted_nicks} = {};
$self->{unban_timeouts} = {};
$self->{op_commands} = [];
$self->{is_opped} = {};
}
sub gain_ops {
my $self = shift;
my $channel = shift;
if(not exists ${ $self->{is_opped} }{$channel}) {
$self->{pbot}->conn->privmsg("chanserv", "op $channel");
} else {
$self->perform_op_commands();
}
}
sub lose_ops {
my $self = shift;
my $channel = shift;
$self->{pbot}->conn->privmsg("chanserv", "op $channel -$self->{pbot}->botnick");
if(exists ${ $self->{is_opped} }{$channel}) {
${ $self->{is_opped} }{$channel}{timeout} = gettimeofday + 60; # try again in 1 minute if failed
}
}
sub perform_op_commands {
my $self = shift;
$self->{pbot}->logger->log("Performing op commands...\n");
foreach my $command (@{ $self->{op_commands} }) {
if($command =~ /^mode (.*?) (.*)/i) {
$self->{pbot}->conn->mode($1, $2);
$self->{pbot}->logger->log(" executing mode $1 $2\n");
} elsif($command =~ /^kick (.*?) (.*?) (.*)/i) {
$self->{pbot}->conn->kick($1, $2, $3) unless $1 =~ /\Q$self->{pbot}->botnick\E/i;
$self->{pbot}->logger->log(" executing kick on $1 $2 $3\n");
}
shift(@{ $self->{op_commands} });
}
$self->{pbot}->logger->log("Done.\n");
}
sub quiet {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my ($target, $length) = split(/\s+/, $arguments);
if(not defined $from) {
$self->{pbot}->logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
return "/msg $nick This command must be used in the channel.";
}
if(not defined $target) {
return "/msg $nick Usage: quiet nick [timeout seconds (default: 3600 or 1 hour)]";
}
if(not defined $length) {
$length = 60 * 60; # one hour
}
return "" if $target =~ /\Q$self->{pbot}->botnick\E/i;
quiet_nick_timed($target, $from, $length);
$self->{pbot}->conn->privmsg($target, "$nick has quieted you for $length seconds.");
}
sub unquiet {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$self->{pbot}->logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
return "/msg $nick This command must be used in the channel.";
}
if(not defined $arguments) {
return "/msg $nick Usage: unquiet nick";
}
unquiet_nick($arguments, $from);
delete ${ $self->{quieted_nicks} }{$arguments};
$self->{pbot}->conn->privmsg($arguments, "$nick has allowed you to speak again.") unless $arguments =~ /\Q$self->{pbot}->botnick\E/i;
}
sub quiet_nick {
my $self = shift;
my ($nick, $channel) = @_;
unshift @{ $self->{op_commands} }, "mode $channel +q $nick!*@*";
gain_ops($channel);
}
sub unquiet_nick {
my $self = shift;
my ($nick, $channel) = @_;
unshift @{ $self->{op_commands} }, "mode $channel -q $nick!*@*";
gain_ops($channel);
}
sub quiet_nick_timed {
my $self = shift;
my ($nick, $channel, $length) = @_;
quiet_nick($nick, $channel);
${ $self->{quieted_nicks} }{$nick}{time} = gettimeofday + $length;
${ $self->{quieted_nicks} }{$nick}{channel} = $channel;
}
# TODO: need to refactor ban_user() and unban_user() - mostly duplicate code
sub ban_user {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$self->{pbot}->logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
if($arguments =~ /^(#.*?) (.*?) (.*)$/) {
$self->{pbot}->conn->privmsg("ChanServ", "AUTOREM $1 ADD $2 $3");
unshift @{ $self->{op_commands} }, "kick $1 $2 Banned";
gain_ops($1);
$self->{pbot}->logger->log("$nick!$user\@$host AUTOREM $2 ($3)\n");
return "/msg $nick $2 added to auto-remove";
} else {
$self->{pbot}->logger->log("$nick!$user\@$host: bad format for ban in msg\n");
return "/msg $nick Usage (in msg mode): !ban <channel> <hostmask> <reason>";
}
} else { #in a channel
if($arguments =~ /^(.*?) (.*)$/) {
$self->{pbot}->conn->privmsg("ChanServ", "AUTOREM $from ADD $1 $2");
$self->{pbot}->logger->log("AUTOREM [$from] ADD [$1] [$2]\n");
$self->{pbot}->logger->log("kick [$from] [$1] Banned\n");
unshift @{ $self->{op_commands} }, "kick $from $1 Banned";
gain_ops($from);
$self->{pbot}->logger->log("$nick ($from) AUTOREM $1 ($2)\n");
return "/msg $nick $1 added to auto-remove";
} else {
$self->{pbot}->logger->log("$nick!$user\@$host: bad format for ban in channel\n");
return "/msg $nick Usage (in channel mode): !ban <hostmask> <reason>";
}
}
}
sub unban_user {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$self->{pbot}->logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
if($arguments =~ /^(#.*?) (.*)$/) {
$self->{pbot}->conn->privmsg("ChanServ", "AUTOREM $1 DEL $2");
unshift @{ $self->{op_commands} }, "mode $1 -b $2";
$self->gain_ops($1);
delete ${ $self->{unban_timeouts} }{$2};
$self->{pbot}->logger->log("$nick!$user\@$host AUTOREM DEL $2 ($3)\n");
return "/msg $nick $2 removed from auto-remove";
} else {
$self->{pbot}->logger->log("$nick!$user\@$host: bad format for unban in msg\n");
return "/msg $nick Usage (in msg mode): !unban <channel> <hostmask>";
}
} else { #in a channel
$self->{pbot}->conn->privmsg("ChanServ", "AUTOREM $from DEL $arguments");
unshift @{ $self->{op_commands} }, "mode $from -b $arguments";
$self->gain_ops($from);
delete ${ $self->{unban_timeouts} }{$arguments};
$self->{pbot}->logger->log("$nick!$user\@$host AUTOREM DEL $arguments\n");
return "/msg $nick $arguments removed from auto-remove";
}
}
sub kick_nick {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$self->{pbot}->logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) {
$self->{pbot}->logger->log("$nick!$user\@$host attempted to /msg kick\n");
return "/msg $nick Kick must be used in the channel.";
}
if(not $arguments =~ /(.*?) (.*)/) {
$self->{pbot}->logger->log("$nick!$user\@$host: invalid arguments to kick\n");
return "/msg $nick Usage: !kick <nick> <reason>";
}
unshift @{ $self->{op_commands} }, "kick $from $1 $2";
$self->gain_ops($from);
}
1;

2
PBot/Changes
View File

@ -10,6 +10,8 @@
# TODO: fix quotegrab ids -- ids not adjusted when quotegrab deleted [for 0.5.0]
# TODO: make most, if not all, hash key comparisions case-insensitive, but store values with case intact! [for 0.5.0]
#
# 0.6.0-beta (03/22/10): Converted everything into objects with zero exports.
# Replaced <STDIN> with sysread(STDIN, ...) in StdinReader.pm as to not mix buffered IO with select()
# 0.5.0-beta (03/16/10): split single large pbot2.pl file into packages and modules
# replaced nick@host with full nick!user@host hostmask throughout [TODO for admin stuff (logged_in, etc)]
# ignore list saves/loads [TODO]

68
PBot/ChannelStuff.pm
View File

@ -1,68 +0,0 @@
# File: NewModule.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
package PBot::ChannelStuff;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($channels_file $logger %channels);
}
use vars @EXPORT_OK;
*channels_file = \$PBot::PBot::channels_file;
*logger = \$PBot::PBot::logger;
%channels = ();
sub load_channels {
open(FILE, "< $channels_file") or die "Couldn't open $channels_file: $!\n";
my @contents = <FILE>;
close(FILE);
$logger->log("Loading channels from $channels_file ...\n");
my $i = 0;
foreach my $line (@contents) {
$i++;
chomp $line;
my ($channel, $enabled, $is_op, $showall) = split(/\s+/, $line);
if(not defined $channel || not defined $is_op || not defined $enabled) {
die "Syntax error around line $i of $channels_file\n";
}
$channel = lc $channel;
if(defined $channels{$channel}) {
die "Duplicate channel $channel found in $channels_file around line $i\n";
}
$channels{$channel}{enabled} = $enabled;
$channels{$channel}{is_op} = $is_op;
$channels{$channel}{showall} = $showall;
$logger->log(" Adding channel $channel (enabled: $enabled, op: $is_op, showall: $showall) ...\n");
}
$logger->log("Done.\n");
}
sub save_channels {
open(FILE, "> $channels_file") or die "Couldn't open $channels_file: $!\n";
foreach my $channel (keys %channels) {
$channel = lc $channel;
print FILE "$channel $channels{$channel}{enabled} $channels{$channel}{is_op} $channels{$channel}{showall}\n";
}
close(FILE);
}
1;

96
PBot/Channels.pm Normal file
View File

@ -0,0 +1,96 @@
# File: Channels.pm
# Authoer: pragma_
#
# Purpose: Manages list of channels and auto-joins.
package PBot::Channels;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
}
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak ("Options to Commands should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak ("Missing pbot reference to Channels");
}
my $channels_file = delete $conf{filename};
$self->{pbot} = $pbot;
$self->{filename} = $channels_file;
$self->{channels} = {};
}
sub load_channels {
my $self = shift;
open(FILE, "< $self->{filename}") or Carp::croak "Couldn't open $self->{filename}: $!\n";
my @contents = <FILE>;
close(FILE);
$self->{pbot}->logger->log("Loading channels from $self->{filename} ...\n");
my $i = 0;
foreach my $line (@contents) {
$i++;
chomp $line;
my ($channel, $enabled, $is_op, $showall) = split(/\s+/, $line);
if(not defined $channel || not defined $is_op || not defined $enabled) {
Carp::croak "Syntax error around line $i of $self->{filename}\n";
}
$channel = lc $channel;
if(defined ${ $self->channels }{$channel}) {
Carp::croak "Duplicate channel $channel found in $self->{filename} around line $i\n";
}
${ $self->channels }{$channel}{enabled} = $enabled;
${ $self->channels }{$channel}{is_op} = $is_op;
${ $self->channels }{$channel}{showall} = $showall;
$self->{pbot}->logger->log(" Adding channel $channel (enabled: $enabled, op: $is_op, showall: $showall) ...\n");
}
$self->{pbot}->logger->log("Done.\n");
}
sub save_channels {
my $self = shift;
open(FILE, "> $self->{filename}") or Carp::croak "Couldn't open $self->{filename}: $!\n";
foreach my $channel (keys %{ $self->channels }) {
$channel = lc $channel;
print FILE "$channel ${ $self->channels }{$channel}{enabled} ${ $self->channels }{$channel}{is_op} ${ $self->channels }{$channel}{showall}\n";
}
close(FILE);
}
sub PBot::Channels::channels {
# Carp::cluck "PBot::Channels::channels";
my $self = shift;
return $self->{channels};
}
1;

111
PBot/Commands.pm Normal file
View File

@ -0,0 +1,111 @@
# File: Commands.pm
# Author: pragma_
#
# Purpose: Derives from Registerable class to provide functionality to
# register subroutines, along with a command name and admin level.
# Registered items will then be executed if their command name matches
# a name provided via input.
#
# Takes BotAdminStuff object in order to use loggedin()
package PBot::Commands;
use warnings;
use strict;
use base 'PBot::Registerable';
BEGIN {
use vars qw($VERSION);
$VERSION = '1.0.0';
}
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Commands should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
$self->SUPER::initialize(%conf);
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to PBot::Commands");
}
$self->{pbot} = $pbot;
$self->{name} = undef;
$self->{level} = undef;
}
sub register {
my $self = shift;
my ($subref, $name, $level) = @_;
if((not defined $subref) || (not defined $name) || (not defined $level)) {
Carp::croak("Missing parameters to Commands::register");
}
$name = lc $name;
my $ref = $self->SUPER::register($subref);
$ref->{name} = $name;
$ref->{level} = $level;
return $ref;
}
sub unregister_by_name {
my ($self, $name) = @_;
if(not defined $name) {
Carp::croak("Missing name parameter to Commands::unregister");
}
$name = lc $name;
@{ $self->{handlers} } = grep { $_->{name} ne $name } @{ $self->{handlers} };
}
sub interpreter {
my $self = shift;
my ($from, $nick, $user, $host, $count, $keyword, $arguments, $tonick) = @_;
my $result;
my $pbot = $self->{pbot};
my $admin = $pbot->admins->loggedin($from, "$nick!$user\@$host");
my $level = defined $admin ? $admin->{level} : 0;
foreach my $ref (@{ $self->{handlers} }) {
if($ref->{name} eq $keyword) {
if($level >= $ref->{level}) {
return &{ $ref->{subref} }($from, $nick, $user, $host, $arguments);
} else {
if($level == 0) {
return "/msg $nick You must login to use this command.";
} else {
return "/msg $nick You are not authorized to use this command.";
}
}
}
}
return undef;
}
1;

602
PBot/FactoidCommands.pm Normal file
View File

@ -0,0 +1,602 @@
# File: FactoidCommands.pm
# Authoer: pragma_
#
# Purpose: Administrative command subroutines.
# TODO: Add getter for factoids instead of directly accessing factoids
package PBot::FactoidCommands;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
}
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to FactoidCommands should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to FactoidCommands");
}
$self->{pbot} = $pbot;
$pbot->commands->register(sub { return $self->list(@_) }, "list", 0);
$pbot->commands->register(sub { return $self->alias(@_) }, "alias", 0);
$pbot->commands->register(sub { return $self->add_regex(@_) }, "regex", 0);
$pbot->commands->register(sub { return $self->add_text(@_) }, "add", 0);
$pbot->commands->register(sub { return $self->add_text(@_) }, "learn", 0);
$pbot->commands->register(sub { return $self->histogram(@_) }, "histogram", 0);
$pbot->commands->register(sub { return $self->show(@_) }, "show", 0);
$pbot->commands->register(sub { return $self->info(@_) }, "info", 0);
$pbot->commands->register(sub { return $self->top20(@_) }, "top20", 0);
$pbot->commands->register(sub { return $self->count(@_) }, "count", 0);
$pbot->commands->register(sub { return $self->find(@_) }, "find", 0);
$pbot->commands->register(sub { return $self->change_text(@_) }, "change", 0);
$pbot->commands->register(sub { return $self->remove_text(@_) }, "remove", 0);
$pbot->commands->register(sub { return $self->remove_text(@_) }, "forget", 0);
$pbot->commands->register(sub { return $self->load_module(@_) }, "load", 50);
$pbot->commands->register(sub { return $self->unload_module(@_) }, "unload", 50);
$pbot->commands->register(sub { return $self->enable_command(@_) }, "enable", 10);
$pbot->commands->register(sub { return $self->disable_command(@_) }, "disable", 10);
}
sub list {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my $text;
if(not defined $arguments) {
return "/msg $nick Usage: list <modules|factoids|commands|admins>";
}
=cut move to PBot::AntiFlood somehow
if($arguments =~/^messages\s+(.*?)\s+(.*)$/) {
my $nick_search = $1;
my $channel = $2;
if(not exists $flood_watch{$nick_search}) {
return "/msg $nick No messages for $nick_search yet.";
}
if(not exists $flood_watch{$nick_search}{$channel}) {
return "/msg $nick No messages for $nick_search in $channel yet.";
}
my @messages = @{ $flood_watch{$nick_search}{$channel}{messages} };
for(my $i = 0; $i <= $#messages; $i++) {
$conn->privmsg($nick, "" . ($i + 1) . ": " . $messages[$i]->{msg} . "\n") unless $nick =~ /\Q$botnick\E/i;
}
return "";
}
if($arguments =~ /^modules$/i) {
$text = "Loaded modules: ";
foreach my $command (sort keys %{ $factoids }) {
if(exists $factoids->{$command}{module}) {
$text .= "$command ";
}
}
return $text;
}
if($arguments =~ /^commands$/i) {
$text = "Internal commands: ";
foreach my $command (sort keys %internal_commands) {
$text .= "$command ";
$text .= "($internal_commands{$command}{level}) "
if $internal_commands{$command}{level} > 0;
}
return $text;
}
if($arguments =~ /^factoids$/i) {
return "For a list of factoids see http://blackshell.com/~msmud/candide/factoids.html";
}
if($arguments =~ /^admins$/i) {
$text = "Admins: ";
foreach my $admin (sort { $admins{$b}{level} <=> $admins{$a}{level} } keys %admins) {
$text .= "*" if exists $admins{$admin}{login};
$text .= "$admin ($admins{$admin}{level}) ";
}
return $text;
}
return "/msg $nick Usage: list <modules|commands|factoids|admins>";
=cut
}
sub alias {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my ($alias, $command) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $command) {
$self->{pbot}->logger->log("alias: invalid usage\n");
return "/msg $nick Usage: alias <keyword> <command>";
}
if(exists $factoids->{$alias}) {
$self->{pbot}->logger->log("attempt to overwrite existing command\n");
return "/msg $nick '$alias' already exists";
}
$factoids->{$alias}{text} = "/call $command";
$factoids->{$alias}{owner} = $nick;
$factoids->{$alias}{timestamp} = time();
$factoids->{$alias}{enabled} = 1;
$factoids->{$alias}{ref_count} = 0;
$factoids->{$alias}{ref_user} = "nobody";
$self->{pbot}->logger->log("$nick!$user\@$host aliased $alias => $command\n");
$self->{pbot}->factoids->save_factoids();
return "/msg $nick '$alias' aliases '$command'";
}
sub add_regex {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my ($keyword, $text) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $keyword) {
$text = "";
foreach my $command (sort keys %{ $factoids }) {
if(exists $factoids->{$command}{regex}) {
$text .= $command . " ";
}
}
return "Stored regexs: $text";
}
if(not defined $text) {
$self->{pbot}->logger->log("add_regex: invalid usage\n");
return "/msg $nick Usage: regex <regex> <command>";
}
if(exists $factoids->{$keyword}) {
$self->{pbot}->logger->log("$nick!$user\@$host attempt to overwrite $keyword\n");
return "/msg $nick $keyword already exists.";
}
$factoids->{$keyword}{regex} = $text;
$factoids->{$keyword}{owner} = $nick;
$factoids->{$keyword}{timestamp} = time();
$factoids->{$keyword}{enabled} = 1;
$factoids->{$keyword}{ref_count} = 0;
$factoids->{$keyword}{ref_user} = "nobody";
$self->{pbot}->logger->log("$nick!$user\@$host added [$keyword] => [$text]\n");
$self->{pbot}->factoids->save_factoids();
return "/msg $nick $keyword added.";
}
sub add_text {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my ($keyword, $text) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $text) {
$self->{pbot}->logger->log("add_text: invalid usage\n");
return "/msg $nick Usage: add <keyword> <factoid>";
}
if(not defined $keyword) {
$self->{pbot}->logger->log("add_text: invalid usage\n");
return "/msg $nick Usage: add <keyword> <factoid>";
}
$text =~ s/^is\s+//;
if(exists $factoids->{$keyword}) {
$self->{pbot}->logger->log("$nick!$user\@$host attempt to overwrite $keyword\n");
return "/msg $nick $keyword already exists.";
}
$factoids->{$keyword}{text} = $text;
$factoids->{$keyword}{owner} = $nick;
$factoids->{$keyword}{timestamp} = time();
$factoids->{$keyword}{enabled} = 1;
$factoids->{$keyword}{ref_count} = 0;
$factoids->{$keyword}{ref_user} = "nobody";
$self->{pbot}->logger->log("$nick!$user\@$host added $keyword => $text\n");
$self->{pbot}->factoids->save_factoids();
return "/msg $nick $keyword added.";
}
sub histogram {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my %hash;
my $factoid_count = 0;
foreach my $command (keys %{ $factoids }) {
if(exists $factoids->{$command}{text}) {
$hash{$factoids->{$command}{owner}}++;
$factoid_count++;
}
}
my $text;
my $i = 0;
foreach my $owner (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
my $percent = int($hash{$owner} / $factoid_count * 100);
$percent = 1 if $percent == 0;
$text .= "$owner: $hash{$owner} ($percent". "%) ";
$i++;
last if $i >= 10;
}
return "$factoid_count factoid_count, top 10 submitters: $text";
}
sub show {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
if(not defined $arguments) {
return "/msg $nick Usage: show <factoid>";
}
if(not exists $factoids->{$arguments}) {
return "/msg $nick $arguments not found";
}
if(exists $factoids->{$arguments}{command} || exists $factoids->{$arguments}{module}) {
return "/msg $nick $arguments is not a factoid";
}
my $type;
$type = 'text' if exists $factoids->{$arguments}{text};
$type = 'regex' if exists $factoids->{$arguments}{regex};
return "$arguments: $factoids->{$arguments}{$type}";
}
sub info {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
if(not defined $arguments) {
return "/msg $nick Usage: info <factoid|module>";
}
if(not exists $factoids->{$arguments}) {
return "/msg $nick $arguments not found";
}
# factoid
if(exists $factoids->{$arguments}{text}) {
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) =
localtime($factoids->{$arguments}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
return "$arguments: Factoid submitted by $factoids->{$arguments}{owner} on $t, referenced $factoids->{$arguments}{ref_count} times (last by $factoids->{$arguments}{ref_user})";
}
# module
if(exists $factoids->{$arguments}{module}) {
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) =
localtime($factoids->{$arguments}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
return "$arguments: Module loaded by $factoids->{$arguments}{owner} on $t -> http://code.google.com/p/pbot2-pl/source/browse/trunk/modules/$factoids->{$arguments}{module}, used $factoids->{$arguments}{ref_count} times (last by $factoids->{$arguments}{ref_user})";
}
# regex
if(exists $factoids->{$arguments}{regex}) {
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) =
localtime($factoids->{$arguments}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
return "$arguments: Regex created by $factoids->{$arguments}{owner} on $t, used $factoids->{$arguments}{ref_count} times (last by $factoids->{$arguments}{ref_user})";
}
return "/msg $nick $arguments is not a factoid or a module";
}
sub top20 {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my %hash = ();
my $text = "";
my $i = 0;
if(not defined $arguments) {
foreach my $command (sort {$factoids->{$b}{ref_count} <=> $factoids->{$a}{ref_count}} keys %{ $factoids }) {
if($factoids->{$command}{ref_count} > 0 && exists $factoids->{$command}{text}) {
$text .= "$command ($factoids->{$command}{ref_count}) ";
$i++;
last if $i >= 20;
}
}
$text = "Top $i referenced factoids: $text" if $i > 0;
return $text;
} else {
if(lc $arguments eq "recent") {
foreach my $command (sort { $factoids->{$b}{timestamp} <=> $factoids->{$a}{timestamp} } keys %{ $factoids }) {
#my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) = localtime($factoids->{$command}{timestamp});
#my $t = sprintf("%04d/%02d/%02d", $year+1900, $month+1, $day_of_month);
$text .= "$command ";
$i++;
last if $i >= 50;
}
$text = "$i most recent submissions: $text" if $i > 0;
return $text;
}
my $user = lc $arguments;
foreach my $command (sort keys %{ $factoids }) {
if($factoids->{$command}{ref_user} =~ /\Q$arguments\E/i) {
if($user ne lc $factoids->{$command}{ref_user} && not $user =~ /$factoids->{$command}{ref_user}/i) {
$user .= " ($factoids->{$command}{ref_user})";
}
$text .= "$command ";
$i++;
last if $i >= 20;
}
}
$text = "$i factoids last referenced by $user: $text" if $i > 0;
return $text;
}
}
sub count {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my $i = 0;
my $total = 0;
if(not defined $arguments) {
return "/msg $nick Usage: count <nick|factoids>";
}
$arguments = ".*" if($arguments =~ /^factoids$/);
eval {
foreach my $command (keys %{ $factoids }) {
$total++ if exists $factoids->{$command}{text};
my $regex = qr/^\Q$arguments\E$/;
if($factoids->{$command}{owner} =~ /$regex/i && exists $factoids->{$command}{text}) {
$i++;
}
}
};
return "/msg $nick $arguments: $@" if $@;
return "I have $i factoids" if($arguments eq ".*");
if($i > 0) {
my $percent = int($i / $total * 100);
$percent = 1 if $percent == 0;
return "$arguments has submitted $i factoids out of $total ($percent"."%)";
} else {
return "$arguments hasn't submitted any factoids";
}
}
sub find {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my $i = 0;
my $text;
my $type;
foreach my $command (sort keys %{ $factoids }) {
if(exists $factoids->{$command}{text} || exists $factoids->{$command}{regex}) {
$type = 'text' if(exists $factoids->{$command}{text});
$type = 'regex' if(exists $factoids->{$command}{regex});
# $self->{pbot}->logger->log("Checking [$command], type: [$type]\n");
eval {
my $regex = qr/$arguments/;
if($factoids->{$command}{$type} =~ /$regex/i || $command =~ /$regex/i)
{
$i++;
$text .= "$command ";
}
};
return "/msg $nick $arguments: $@" if $@;
}
}
if($i == 1) {
chop $text;
$type = 'text' if exists $factoids->{$text}{text};
$type = 'regex' if exists $factoids->{$text}{regex};
return "found one match: '$text' is '$factoids->{$text}{$type}'";
} else {
return "$i factoids contain '$arguments': $text" unless $i == 0;
return "No factoids contain '$arguments'";
}
}
sub change_text {
my $self = shift;
$self->{pbot}->logger->log("Enter change_text\n");
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my ($keyword, $delim, $tochange, $changeto, $modifier);
if(defined $arguments) {
if($arguments =~ /^(.*?)\s+s(.)/) {
$keyword = $1;
$delim = $2;
}
if($arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/) {
$tochange = $1;
$changeto = $2;
$modifier = $3;
}
}
if(not defined $changeto) {
$self->{pbot}->logger->log("($from) $nick!$user\@$host: improper use of change\n");
return "/msg $nick Usage: change <keyword> s/<to change>/<change to>/";
}
if(not exists $factoids->{$keyword}) {
$self->{pbot}->logger->log("($from) $nick!$user\@$host: attempted to change nonexistant '$keyword'\n");
return "/msg $nick $keyword not found.";
}
my $type;
$type = 'text' if exists $factoids->{$keyword}{text};
$type = 'regex' if exists $factoids->{$keyword}{regex};
$self->{pbot}->logger->log("keyword: $keyword, type: $type, tochange: $tochange, changeto: $changeto\n");
my $ret = eval {
my $regex = qr/$tochange/;
if(not $factoids->{$keyword}{$type} =~ s|$regex|$changeto|) {
$self->{pbot}->logger->log("($from) $nick!$user\@$host: failed to change '$keyword' 's$delim$tochange$delim$changeto$delim\n");
return "/msg $nick Change $keyword failed.";
} else {
$self->{pbot}->logger->log("($from) $nick!$user\@$host: changed '$keyword' 's/$tochange/$changeto/\n");
$self->{pbot}->factoids->save_factoids();
return "Changed: $keyword is $factoids->{$keyword}{$type}";
}
};
return "/msg $nick Change $keyword: $@" if $@;
return $ret;
}
sub remove_text {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
if(not defined $arguments) {
$self->{pbot}->logger->log("remove_text: invalid usage\n");
return "/msg $nick Usage: remove <keyword>";
}
$self->{pbot}->logger->log("Attempting to remove [$arguments]\n");
if(not exists $factoids->{$arguments}) {
return "/msg $nick $arguments not found.";
}
if(exists $factoids->{$arguments}{command} || exists $factoids->{$arguments}{module}) {
$self->{pbot}->logger->log("$nick!$user\@$host attempted to remove $arguments [not factoid]\n");
return "/msg $nick $arguments is not a factoid.";
}
if(($nick ne $factoids->{$arguments}{owner}) and (not $self->{pbot}->admins->loggedin($from, "$nick!$user\@$host"))) {
$self->{pbot}->logger->log("$nick!$user\@$host attempted to remove $arguments [not owner]\n");
return "/msg $nick You are not the owner of '$arguments'";
}
$self->{pbot}->logger->log("$nick!$user\@$host removed [$arguments][$factoids->{$arguments}{text}]\n") if(exists $factoids->{$arguments}{text});
$self->{pbot}->logger->log("$nick!$user\@$host removed [$arguments][$factoids->{$arguments}{regex}]\n") if(exists $factoids->{$arguments}{regex});
delete $factoids->{$arguments};
$self->{pbot}->factoids->save_factoids();
return "/msg $nick $arguments removed.";
}
sub load_module {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
my ($keyword, $module) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $arguments) {
return "/msg $nick Usage: load <command> <module>";
}
if(not exists($factoids->{$keyword})) {
$factoids->{$keyword}{module} = $module;
$factoids->{$keyword}{enabled} = 1;
$factoids->{$keyword}{owner} = $nick;
$factoids->{$keyword}{timestamp} = time();
$self->{pbot}->logger->log("$nick!$user\@$host loaded $keyword => $module\n");
$self->{pbot}->factoids->save_factoids();
return "/msg $nick Loaded $keyword => $module";
} else {
return "/msg $nick There is already a command named $keyword.";
}
}
sub unload_module {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
if(not defined $arguments) {
return "/msg $nick Usage: unload <module>";
} elsif(not exists $factoids->{$arguments}) {
return "/msg $nick $arguments not found.";
} elsif(not exists $factoids->{$arguments}{module}) {
return "/msg $nick $arguments is not a module.";
} else {
delete $factoids->{$arguments};
$self->{pbot}->factoids->save_factoids();
$self->{pbot}->logger->log("$nick!$user\@$host unloaded module $arguments\n");
return "/msg $nick $arguments unloaded.";
}
}
sub enable_command {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
if(not defined $arguments) {
return "/msg $nick Usage: enable <command>";
} elsif(not exists $factoids->{$arguments}) {
return "/msg $nick $arguments not found.";
} else {
$factoids->{$arguments}{enabled} = 1;
$self->{pbot}->factoids->save_factoids();
$self->{pbot}->logger->log("$nick!$user\@$host enabled $arguments\n");
return "/msg $nick $arguments enabled.";
}
}
sub disable_command {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->factoids->factoids;
if(not defined $arguments) {
return "/msg $nick Usage: disable <command>";
} elsif(not exists $factoids->{$arguments}) {
return "/msg $nick $arguments not found.";
} else {
$factoids->{$arguments}{enabled} = 0;
$self->{pbot}->factoids->save_factoids();
$self->{pbot}->logger->log("$nick!$user\@$host disabled $arguments\n");
return "/msg $nick $arguments disabled.";
}
}
1;

89
PBot/FactoidModuleLauncher.pm Normal file
View File

@ -0,0 +1,89 @@
# File: FactoidModuleLauncher.pm
# Authoer: pragma_
#
# Purpose: Handles forking and execution of module processes
package PBot::FactoidModuleLauncher;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
}
use POSIX qw(WNOHANG); # for children process reaping
use Carp ();
# automatically reap children processes in background
$SIG{CHLD} = sub { while(waitpid(-1, WNOHANG) > 0) {} };
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Commands should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to PBot::FactoidModuleLauncher");
}
$self->{child} = 0;
$self->{pbot} = $pbot;
}
sub execute_module {
my ($self, $from, $tonick, $nick, $user, $host, $keyword, $arguments) = @_;
my $text;
$arguments = "" if not defined $arguments;
my $module = $self->{pbot}->factoids->factoids->{$keyword}{module};
my $module_dir = $self->{pbot}->module_dir;
$self->{pbot}->logger->log("(" . (defined $from ? $from : "(undef)") . "): $nick!$user\@$host: Executing module $module $arguments\n");
$arguments = quotemeta($arguments);
$arguments =~ s/\\\s+/ /;
my $pid = fork;
if(not defined $pid) {
$self->{pbot}->logger->log("Could not fork module: $!\n");
return "/me groans loudly.";
}
# FIXME -- add check to ensure $module} exists
if($pid == 0) { # start child block
$self->{child} = 1; # set to be killed after returning
if(defined $tonick) {
$self->{pbot}->logger->log("($from): $nick!$user\@$host) sent to $tonick\n");
$text = `$module_dir/$module $arguments`;
if(defined $text && length $text > 0) {
return "$tonick: $text";
} else {
return "";
}
} else {
return `$module_dir/$module $arguments`;
}
return "/me moans loudly."; # er, didn't execute the module?
} # end child block
return ""; # child returns bot command, not parent -- so return blank/no command
}
1;

127
PBot/FactoidStuff.pm
View File

@ -1,127 +0,0 @@
# File: NewModule.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
package PBot::FactoidStuff;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($logger %commands $commands_file $export_factoids_path $export_factoids_timeout);
}
use vars @EXPORT_OK;
*logger = \$PBot::PBot::logger;
*commands_file = \$PBot::PBot::commands_file;
*export_factoids_path = \$PBot::PBot::export_factoids_path;
*export_factoids_timeout = \$PBot::PBot::export_factoids_timeout;
# TODO: move into pbot object, or make FactoidStuff an object and move this into it
%commands = ();
sub load_commands {
$logger->log("Loading commands from $commands_file ...\n");
open(FILE, "< $commands_file") or die "Couldn't open $commands_file: $!\n";
my @contents = <FILE>;
close(FILE);
my $i = 0;
foreach my $line (@contents) {
chomp $line;
$i++;
my ($command, $type, $enabled, $owner, $timestamp, $ref_count, $ref_user, $value) = split(/\s+/, $line, 8);
if(not defined $command || not defined $enabled || not defined $owner || not defined $timestamp
|| not defined $type || not defined $ref_count
|| not defined $ref_user || not defined $value) {
die "Syntax error around line $i of $commands_file\n";
}
if(exists $commands{$command}) {
die "Duplicate command $command found in $commands_file around line $i\n";
}
$commands{$command}{enabled} = $enabled;
$commands{$command}{$type} = $value;
$commands{$command}{owner} = $owner;
$commands{$command}{timestamp} = $timestamp;
$commands{$command}{ref_count} = $ref_count;
$commands{$command}{ref_user} = $ref_user;
# $logger->log(" Adding command $command ($type): $owner, $timestamp...\n");
}
$logger->log(" $i commands loaded.\n");
$logger->log("Done.\n");
}
sub save_commands {
open(FILE, "> $commands_file") or die "Couldn't open $commands_file: $!\n";
foreach my $command (sort keys %commands) {
next if $command eq "version";
if(defined $commands{$command}{module} || defined $commands{$command}{text} || defined $commands{$command}{regex}) {
print FILE "$command ";
} else {
$logger->log("save_commands: unknown command type $command\n");
next;
}
#bleh, this is ugly - duplicated
if(defined $commands{$command}{module}) {
print FILE "module ";
print FILE "$commands{$command}{enabled} $commands{$command}{owner} $commands{$command}{timestamp} ";
print FILE "$commands{$command}{ref_count} $commands{$command}{ref_user} ";
print FILE "$commands{$command}{module}\n";
} elsif(defined $commands{$command}{text}) {
print FILE "text ";
print FILE "$commands{$command}{enabled} $commands{$command}{owner} $commands{$command}{timestamp} ";
print FILE "$commands{$command}{ref_count} $commands{$command}{ref_user} ";
print FILE "$commands{$command}{text}\n";
} elsif(defined $commands{$command}{regex}) {
print FILE "regex ";
print FILE "$commands{$command}{enabled} $commands{$command}{owner} $commands{$command}{timestamp} ";
print FILE "$commands{$command}{ref_count} $commands{$command}{ref_user} ";
print FILE "$commands{$command}{regex}\n";
} else {
$logger->log("save_commands: skipping unknown command type for $command\n");
}
}
close(FILE);
}
sub export_factoids() {
my $text;
open FILE, "> $export_factoids_path" or return "Could not open export path.";
my $time = localtime;
print FILE "<html><body><i>Generated at $time</i><hr><h3>Candide's factoids:</h3><br>\n";
my $i = 0;
print FILE "<table border=\"0\">\n";
foreach my $command (sort keys %commands) {
if(exists $commands{$command}{text}) {
$i++;
if($i % 2) {
print FILE "<tr bgcolor=\"#dddddd\">\n";
} else {
print FILE "<tr>\n";
}
$text = "<td><b>$command</b> is " . encode_entities($commands{$command}{text}) . "</td>\n";
print FILE $text;
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) = localtime($commands{$command}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d\n",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
print FILE "<td align=\"right\">- submitted by<br> $commands{$command}{owner}<br><i>$t</i>\n";
print FILE "</td></tr>\n";
}
}
print FILE "</table>\n";
print FILE "<hr>$i factoids memorized.<br>This page is automatically generated every $export_factoids_timeout seconds.</body></html>";
close(FILE);
#$logger->log("$i factoids exported.\n");
return "$i factoids exported to http://blackshell.com/~msmud/candide/factoids.html";
}
1;

445
PBot/Factoids.pm Normal file
View File

@ -0,0 +1,445 @@
# File: Factoids.pm
# Authoer: pragma_
#
# Purpose: Provides functionality for factoids and a type of external module execution.
package PBot::Factoids;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
}
use HTML::Entities;
use Time::HiRes qw(gettimeofday);
use Carp ();
use PBot::FactoidModuleLauncher;
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Factoids should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $filename = delete $conf{filename};
my $export_path = delete $conf{export_path};
my $export_site = delete $conf{export_site};
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to Factoids");
}
my $export_timeout = delete $conf{export_timeout};
if(not defined $export_timeout) {
if(defined $export_path) {
$export_timeout = 300; # every 5 minutes
} else {
$export_timeout = -1;
}
}
$self->{factoids} = {};
$self->{filename} = $filename;
$self->{export_path} = $export_path;
$self->{export_site} = $export_site;
$self->{export_timeout} = $export_timeout;
$self->{pbot} = $pbot;
$self->{factoidmodulelauncher} = PBot::FactoidModuleLauncher->new(pbot => $pbot);
}
sub load_factoids {
my $self = shift;
my $filename;
if(@_) { $filename = shift; } else { $filename = $self->filename; }
if(not defined $filename) {
Carp::carp "No factoids path specified -- skipping loading of factoids";
return;
}
$self->{pbot}->logger->log("Loading factoids from $filename ...\n");
open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n";
my @contents = <FILE>;
close(FILE);
my $i = 0;
my ($text, $regex, $modules);
foreach my $line (@contents) {
chomp $line;
$i++;
my ($command, $type, $enabled, $owner, $timestamp, $ref_count, $ref_user, $value) = split(/\s+/, $line, 8);
if(not defined $command || not defined $enabled || not defined $owner || not defined $timestamp
|| not defined $type || not defined $ref_count
|| not defined $ref_user || not defined $value) {
Carp::croak "Syntax error around line $i of $filename\n";
}
if(exists ${ $self->factoids }{$command}) {
Carp::croak "Duplicate factoid $command found in $filename around line $i\n";
}
$type = lc $type;
${ $self->factoids }{$command}{enabled} = $enabled;
${ $self->factoids }{$command}{$type} = $value;
${ $self->factoids }{$command}{owner} = $owner;
${ $self->factoids }{$command}{timestamp} = $timestamp;
${ $self->factoids }{$command}{ref_count} = $ref_count;
${ $self->factoids }{$command}{ref_user} = $ref_user;
if($type eq "text") {
$text++;
} elsif($type eq "regex") {
$regex++;
} elsif($type eq "module") {
$modules++;
} else {
Carp::croak "Unknown type '$type' in $filename around line $i\n";
}
}
$self->{pbot}->logger->log(" $i factoids loaded ($text factoids, $regex regexs, $modules modules).\n");
$self->{pbot}->logger->log("Done.\n");
}
sub save_factoids {
my $self = shift;
my $filename;
if(@_) { $filename = shift; } else { $filename = $self->filename; }
if(not defined $filename) {
Carp::carp "No factoids path specified -- skipping saving of factoids\n";
return;
}
open(FILE, "> $filename") or die "Couldn't open $filename: $!\n";
foreach my $command (sort keys %{ $self->factoids }) {
next if $command eq "version";
if(defined ${ $self->factoids }{$command}{module} || defined ${ $self->factoids }{$command}{text} || defined ${ $self->factoids }{$command}{regex}) {
print FILE "$command ";
} else {
$self->{pbot}->logger->log("save_commands: unknown command type $command\n");
next;
}
#bleh, this is ugly - duplicated
if(defined ${ $self->factoids }{$command}{module}) {
print FILE "module ";
print FILE "${ $self->factoids }{$command}{enabled} ${ $self->factoids }{$command}{owner} ${ $self->factoids }{$command}{timestamp} ";
print FILE "${ $self->factoids }{$command}{ref_count} ${ $self->factoids }{$command}{ref_user} ";
print FILE "${ $self->factoids }{$command}{module}\n";
} elsif(defined ${ $self->factoids }{$command}{text}) {
print FILE "text ";
print FILE "${ $self->factoids }{$command}{enabled} ${ $self->factoids }{$command}{owner} ${ $self->factoids }{$command}{timestamp} ";
print FILE "${ $self->factoids }{$command}{ref_count} ${ $self->factoids }{$command}{ref_user} ";
print FILE "${ $self->factoids }{$command}{text}\n";
} elsif(defined ${ $self->factoids }{$command}{regex}) {
print FILE "regex ";
print FILE "${ $self->factoids }{$command}{enabled} ${ $self->factoids }{$command}{owner} ${ $self->factoids }{$command}{timestamp} ";
print FILE "${ $self->factoids }{$command}{ref_count} ${ $self->factoids }{$command}{ref_user} ";
print FILE "${ $self->factoids }{$command}{regex}\n";
} else {
$self->{pbot}->logger->log("save_commands: skipping unknown command type for $command\n");
}
}
close(FILE);
}
sub add_factoid {
my $self = shift;
my ($type, $channel, $owner, $command, $text) = @_;
$type = lc $type;
$channel = lc $channel;
$command = lc $command;
${ $self->factoids }{$command}{enabled} = 1;
${ $self->factoids }{$command}{$type} = $text;
${ $self->factoids }{$command}{owner} = $owner;
${ $self->factoids }{$command}{channel} = $channel;
${ $self->factoids }{$command}{timestamp} = gettimeofday;
${ $self->factoids }{$command}{ref_count} = 0;
${ $self->factoids }{$command}{ref_user} = "nobody";
}
sub export_factoids {
my $self = shift;
my $filename;
if(@_) { $filename = shift; } else { $filename = $self->export_path; }
return if not defined $filename;
my $text;
open FILE, "> $filename" or return "Could not open export path.";
my $time = localtime;
print FILE "<html><body><i>Generated at $time</i><hr><h3>Candide's factoids:</h3><br>\n";
my $i = 0;
print FILE "<table border=\"0\">\n";
foreach my $command (sort keys %{ $self->factoids }) {
if(exists ${ $self->factoids }{$command}{text}) {
$i++;
if($i % 2) {
print FILE "<tr bgcolor=\"#dddddd\">\n";
} else {
print FILE "<tr>\n";
}
$text = "<td><b>$command</b> is " . encode_entities(${ $self->factoids }{$command}{text}) . "</td>\n";
print FILE $text;
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) = localtime(${ $self->factoids }{$command}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d\n",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
print FILE "<td align=\"right\">- submitted by<br> ${ $self->factoids }{$command}{owner}<br><i>$t</i>\n";
print FILE "</td></tr>\n";
}
}
print FILE "</table>\n";
print FILE "<hr>$i factoids memorized.<br>";
print FILE "This page is automatically generated every " . $self->export_timeout . " seconds.</body></html>" if $self->export_timeout > 0;
close(FILE);
$self->{pbot}->logger->log("$i factoids exported to path: " . $self->export_path . ", site: " . $self->export_site . "\n");
return "$i factoids exported to " . $self->export_site;
}
sub interpreter {
my $self = shift;
my ($from, $nick, $user, $host, $count, $keyword, $arguments, $tonick) = @_;
my $result;
my $pbot = $self->{pbot};
foreach my $command (keys %{ $self->factoids }) {
if(lc $keyword eq lc $command) {
$self->{pbot}->logger->log("=======================\n");
$self->{pbot}->logger->log("[$keyword] == [$command]\n");
if(${ $self->factoids }{$command}{enabled} == 0) {
$self->{pbot}->logger->log("$command disabled.\n");
return "$command is currently disabled.";
} elsif(exists ${ $self->factoids }{$command}{module}) {
$self->{pbot}->logger->log("Found module\n");
${ $self->factoids }{$keyword}{ref_count}++;
${ $self->factoids }{$keyword}{ref_user} = $nick;
return $self->{factoidmodulelauncher}->execute_module($from, $tonick, $nick, $user, $host, $keyword, $arguments);
}
elsif(exists ${ $self->factoids }{$command}{text}) {
$self->{pbot}->logger->log("Found factoid\n");
# Don't allow user-custom /msg factoids, unless factoid triggered by admin
if((${ $self->factoids }{$command}{text} =~ m/^\/msg/i) and (not $self->{pbot}->admins->loggedin($from, "$nick!$user\@$host"))) {
$self->{pbot}->logger->log("[HACK] Bad factoid (contains /msg): ${ $self->factoids }{$command}{text}\n");
return "You must login to use this command."
}
${ $self->factoids }{$command}{ref_count}++;
${ $self->factoids }{$command}{ref_user} = $nick;
$self->{pbot}->logger->log("(" . (defined $from ? $from : "(undef)") . "): $nick!$user\@$host): $command: Displaying text \"${ $self->factoids }{$command}{text}\"\n");
if(defined $tonick) { # !tell foo about bar
$self->{pbot}->logger->log("($from): $nick!$user\@$host) sent to $tonick\n");
my $fromnick = $self->{pbot}->admins->loggedin($from, "$nick!$user\@$host") ? "" : "$nick wants you to know: ";
$result = ${ $self->factoids }{$command}{text};
my $botnick = "wtf"; # FIXME: wtf
if($result =~ s/^\/say\s+//i || $result =~ s/^\/me\s+/* $botnick /i
|| $result =~ /^\/msg\s+/i) {
$result = "/msg $tonick $fromnick$result";
} else {
$result = "/msg $tonick $fromnick$command is $result";
}
$self->{pbot}->logger->log("text set to [$result]\n");
} else {
$result = ${ $self->factoids }{$command}{text};
}
if(defined $arguments) {
$self->{pbot}->logger->log("got arguments: [$arguments]\n");
# TODO - extract and remove $tonick from end of $arguments
if(not $result =~ s/\$args/$arguments/gi) {
$self->{pbot}->logger->log("factoid doesn't take argument, checking ...\n");
# factoid doesn't take an argument
if($arguments =~ /^[^ ]{1,20}$/) {
# might be a nick
$self->{pbot}->logger->log("could be nick\n");
if($result =~ /^\/.+? /) {
$result =~ s/^(\/.+?) /$1 $arguments: /;
} else {
$result =~ s/^/\/say $arguments: $command is / unless (defined $tonick);
}
} else {
if($result !~ /^\/.+? /) {
$result =~ s/^/\/say $command is / unless (defined $tonick);
}
}
$self->{pbot}->logger->log("updated text: [$result]\n");
}
$self->{pbot}->logger->log("replaced \$args: [$result]\n");
} else {
# no arguments supplied
$result =~ s/\$args/$nick/gi;
}
$result =~ s/\$nick/$nick/g;
while($result =~ /[^\\]\$([^\s!+.$\/\\,;=&]+)/g) {
my $var = $1;
#$self->{pbot}->logger->log("adlib: got [$var]\n");
#$self->{pbot}->logger->log("adlib: parsing variable [\$$var]\n");
if(exists ${ $self->factoids }{$var} && exists ${ $self->factoids }{$var}{text}) {
my $change = ${ $self->factoids }{$var}{text};
my @list = split(/\s|(".*?")/, $change);
my @mylist;
#$self->{pbot}->logger->log("adlib: list [". join(':', @mylist) ."]\n");
for(my $i = 0; $i <= $#list; $i++) {
#$self->{pbot}->logger->log("adlib: pushing $i $list[$i]\n");
push @mylist, $list[$i] if $list[$i];
}
my $line = int(rand($#mylist + 1));
$mylist[$line] =~ s/"//g;
$result =~ s/\$$var/$mylist[$line]/;
#$self->{pbot}->logger->log("adlib: found: change: $result\n");
} else {
$result =~ s/\$$var/$var/g;
#$self->{pbot}->logger->log("adlib: not found: change: $result\n");
}
}
$result =~ s/\\\$/\$/g;
# $self->{pbot}->logger->log("finally... [$result]\n");
if($result =~ s/^\/say\s+//i || $result =~ /^\/me\s+/i
|| $result =~ /^\/msg\s+/i) {
# $self->{pbot}->logger->log("ret1\n");
return $result;
} else {
# $self->{pbot}->logger->log("ret2\n");
return "$command is $result";
}
$self->{pbot}->logger->log("unknown3: [$result]\n");
} else {
$self->{pbot}->logger->log("($from): $nick!$user\@$host): Unknown command type for '$command'\n");
return "/me blinks.";
}
$self->{pbot}->logger->log("unknown4: [$result]\n");
} # else no match
} # end foreach
#$self->{pbot}->logger->log("Checking regex factoids\n");
# Otherwise, the command was not found.
# Lets try regexp factoids ...
my $string = "$keyword" . (defined $arguments ? " $arguments" : "");
foreach my $command (sort keys %{ $self->factoids }) {
if(exists ${ $self->factoids }{$command}{regex}) {
eval {
my $regex = qr/$command/i;
# $self->{pbot}->logger->log("testing $string =~ $regex\n");
if($string =~ $regex) {
$self->{pbot}->logger->log("[$string] matches [$command][$regex] - calling [" . ${ $self->factoids }{$command}{regex}. "$']\n");
my $cmd = "${ $self->factoids }{$command}{regex}$'";
my $a = $1;
my $b = $2;
my $c = $3;
my $d = $4;
my $e = $5;
my $f = $6;
my $g = $7;
my $h = $8;
my $i = $9;
my $before = $`;
my $after = $';
$cmd =~ s/\$1/$a/g;
$cmd =~ s/\$2/$b/g;
$cmd =~ s/\$3/$c/g;
$cmd =~ s/\$4/$d/g;
$cmd =~ s/\$5/$e/g;
$cmd =~ s/\$6/$f/g;
$cmd =~ s/\$7/$g/g;
$cmd =~ s/\$8/$h/g;
$cmd =~ s/\$9/$i/g;
$cmd =~ s/\$`/$before/g;
$cmd =~ s/\$'/$after/g;
$cmd =~ s/^\s+//;
$cmd =~ s/\s+$//;
$result = $pbot->interpreter->interpret($from, $nick, $user, $host, $count, $cmd);
return $result;
}
};
if($@) {
$self->{pbot}->logger->log("Regex fail: $@\n");
return "/msg $nick Fail.";
}
}
}
return undef;
}
sub export_path {
my $self = shift;
if(@_) { $self->{export_path} = shift; }
return $self->{export_path};
}
sub export_timeout {
my $self = shift;
if(@_) { $self->{export_timeout} = shift; }
return $self->{export_timeout};
}
sub logger {
my $self = shift;
if(@_) { $self->{logger} = shift; }
return $self->{logger};
}
sub export_site {
my $self = shift;
if(@_) { $self->{export_site} = shift; }
return $self->{export_site};
}
sub factoids {
my $self = shift;
return $self->{factoids};
}
sub filename {
my $self = shift;
if(@_) { $self->{filename} = shift; }
return $self->{filename};
}
1;

115
PBot/IRCHandlers.pm
View File

@ -1,5 +1,5 @@
# File: IRCHandlers.pm
# Authoer: pragma_
# Author: pragma_
#
# Purpose: Subroutines to handle IRC events
@ -9,55 +9,60 @@ use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($logger $identify_password %channels $botnick %is_opped %unban_timeout %admins);
}
use vars @EXPORT_OK;
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to IRCHandlers should be key/value pairs, not hash reference");
}
*logger = \$PBot::PBot::logger;
*unban_timeout = \%PBot::OperatorStuff::unban_timeout;
*admins = \%PBot::BotAdminStuff::admins;
*channels = \%PBot::ChannelStuff::channels;
*identify_password = \$PBot::PBot::identify_password;
*botnick = \$PBot::PBot::botnick;
*is_opped = \%PBot::OperatorStuff::is_opped;
my ($class, %conf) = @_;
use Time::HiRes qw(gettimeofday);
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
Carp::croak("Missing pbot parameter to IRCHandlers") if not defined $pbot;
$self->{pbot} = $pbot;
}
# IRC related subroutines
#################################################
sub on_connect {
my $conn = shift;
$logger->log("Connected! Identifying with NickServ . . .\n");
$conn->privmsg("nickserv", "identify $identify_password");
my ($self, $conn) = @_;
$self->{pbot}->logger->log("Connected! Identifying with NickServ . . .\n");
$conn->privmsg("nickserv", "identify " . $self->pbot->identify_password);
$conn->{connected} = 1;
}
sub on_disconnect {
my ($self, $event) = @_;
$logger->log("Disconnected, attempting to reconnect...\n");
$self->connect();
if(not $self->connected) {
my ($self, $conn, $event) = @_;
$self->{pbot}->logger->log("Disconnected, attempting to reconnect...\n");
$conn->connect();
if(not $conn->connected) {
sleep(5);
on_disconnect($self, $event)
on_disconnect($self, $conn, $event)
}
}
sub on_init {
my ($self, $event) = @_;
my ($self, $conn, $event) = @_;
my (@args) = ($event->args);
shift (@args);
$logger->log("*** @args\n");
$self->{pbot}->logger->log("*** @args\n");
}
sub on_public {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
my $from = $event->{to}[0];
my $nick = $event->nick;
@ -65,31 +70,31 @@ sub on_public {
my $host = $event->host;
my $text = $event->{args}[0];
PBot::Interpreter::process_line($from, $nick, $user, $host, $text);
$self->pbot->interpreter->process_line($from, $nick, $user, $host, $text);
}
sub on_msg {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
my ($nick, $host) = ($event->nick, $event->host);
my $text = $event->{args}[0];
$text =~ s/^!?(.*)/\!$1/;
$event->{to}[0] = $nick;
$event->{args}[0] = $text;
on_public($conn, $event);
on_public($self, $conn, $event);
}
sub on_notice {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
my ($nick, $host) = ($event->nick, $event->host);
my $text = $event->{args}[0];
$logger->log("Received NOTICE from $nick $host '$text'\n");
$self->{pbot}->logger->log("Received NOTICE from $nick $host '$text'\n");
if($nick eq "NickServ" && $text =~ m/You are now identified/i) {
foreach my $chan (keys %channels) {
if($channels{$chan}{enabled} != 0) {
$logger->log("Joining channel: $chan\n");
foreach my $chan (keys %{ $self->{pbot}->channels->channels }) {
if(${ $self->{pbot}->channels->channels }{$chan}{enabled} != 0) {
$self->{pbot}->logger->log("Joining channel: $chan\n");
$conn->join($chan);
}
}
@ -97,33 +102,34 @@ sub on_notice {
}
sub on_action {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
on_public($conn, $event);
on_public($self, $conn, $event);
}
sub on_mode {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
my ($nick, $host) = ($event->nick, $event->host);
my $mode = $event->{args}[0];
my $target = $event->{args}[1];
my $channel = $event->{to}[0];
$channel = lc $channel;
$logger->log("Got mode: nick: $nick, host: $host, mode: $mode, target: " . (defined $target ? $target : "") . ", channel: $channel\n");
$self->{pbot}->logger->log("Got mode: nick: $nick, host: $host, mode: $mode, target: " . (defined $target ? $target : "") . ", channel: $channel\n");
=cut
if(defined $target && $target eq $botnick) { # bot targeted
if($mode eq "+o") {
$logger->log("$nick opped me in $channel\n");
$self->{pbot}->logger->log("$nick opped me in $channel\n");
if(exists $is_opped{$channel}) {
$logger->log("warning: erm, I was already opped?\n");
$self->{pbot}->logger->log("warning: erm, I was already opped?\n");
}
$is_opped{$channel}{timeout} = gettimeofday + 300; # 5 minutes
PBot::OperatorStuff::perform_op_commands();
} elsif($mode eq "-o") {
$logger->log("$nick removed my ops in $channel\n");
$self->{pbot}->logger->log("$nick removed my ops in $channel\n");
if(not exists $is_opped{$channel}) {
$logger->log("warning: erm, I wasn't opped?\n");
$self->{pbot}->logger->log("warning: erm, I wasn't opped?\n");
}
delete $is_opped{$channel};
}
@ -136,33 +142,46 @@ sub on_mode {
} elsif($mode eq "+e" && $channel eq $botnick) {
foreach my $chan (keys %channels) {
if($channels{$chan}{enabled} != 0) {
$logger->log("Joining channel: $chan\n");
$self->{pbot}->logger->log("Joining channel: $chan\n");
$conn->join($chan);
}
}
}
}
=cut
}
sub on_join {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
my ($nick, $host, $channel) = ($event->nick, $event->host, $event->to);
#$logger->log("$nick!$user\@$host joined $channel\n");
#$self->{pbot}->logger->log("$nick!$user\@$host joined $channel\n");
#check_flood($nick, $host, $channel, 3, $FLOOD_JOIN);
}
sub on_departure {
my ($conn, $event) = @_;
my ($self, $conn, $event) = @_;
my ($nick, $host, $channel) = ($event->nick, $event->host, $event->to);
#check_flood($nick, $host, $channel, 3, $FLOOD_JOIN);
=cut
if(exists $admins{$nick} && exists $admins{$nick}{login}) {
$logger->log("Whoops, $nick left while still logged in.\n");
$logger->log("Logged out $nick.\n");
$self->{pbot}->logger->log("Whoops, $nick left while still logged in.\n");
$self->{pbot}->logger->log("Logged out $nick.\n");
delete $admins{$nick}{login};
}
=cut
}
sub logger {
my $self = shift;
return $self->{logger};
}
sub pbot {
my $self = shift;
return $self->{pbot};
}
1;

108
PBot/IgnoreList.pm
View File

@ -1,105 +1,73 @@
# File: NewModule.pm
# File: IgnoreList.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
# Purpose: Manages ignore list.
package PBot::IgnoreList;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($logger %ignore_list);
}
use vars @EXPORT_OK;
*logger = \$PBot::PBot::logger;
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
use Time::HiRes qw(gettimeofday);
%ignore_list = ();
sub ignore_user {
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Usage: ignore nick!user\@host [channel] [timeout]" if not defined $arguments;
my ($target, $channel, $length) = split /\s+/, $arguments;
if(not defined $target) {
return "/msg $nick Usage: ignore host [channel] [timeout]";
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Commands should be key/value pairs, not hash reference");
}
if($target =~ /^list$/i) {
my $text = "Ignored: ";
my $sep = "";
my ($class, %conf) = @_;
foreach my $ignored (keys %ignore_list) {
foreach my $channel (keys %{ $ignore_list{$ignored} }) {
$text .= $sep . "[$ignored][$channel]" . int(gettimeofday - $ignore_list{$ignored}{$channel});
$sep = "; ";
}
}
return "/msg $nick $text";
}
if(not defined $channel) {
$channel = ".*"; # all channels
}
if(not defined $length) {
$length = 300; # 5 minutes
}
$logger->log("$nick added [$target][$channel] to ignore list for $length seconds\n");
$ignore_list{$target}{$channel} = gettimeofday + $length;
return "/msg $nick [$target][$channel] added to ignore list for $length seconds";
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub unignore_user {
my ($from, $nick, $user, $host, $arguments) = @_;
my ($target, $channel) = split /\s+/, $arguments;
sub initialize {
my ($self, %conf) = @_;
if(not defined $target) {
return "/msg $nick Usage: unignore host [channel]";
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to Channels");
}
if(not defined $channel) {
$channel = ".*";
}
if(not exists $ignore_list{$target}{$channel}) {
$logger->log("$nick attempt to remove nonexistent [$target][$channel] from ignore list\n");
return "/msg $nick [$target][$channel] not found in ignore list (use '!ignore list' to list ignores";
}
delete $ignore_list{$target}{$channel};
$logger->log("$nick removed [$target][$channel] from ignore list\n");
return "/msg $nick [$target][$channel] unignored";
$self->{pbot} = $pbot;
$self->{ignore_list} = {};
}
sub add {
my $self = shift;
my ($hostmask, $channel, $length) = @_;
${ $self->{ignore_list} }{$hostmask}{$channel} = gettimeofday + $length;
}
sub remove {
my $self = shift;
my ($hostmask, $channel) = @_;
delete ${ $self->{ignore_list} }{$hostmask}{$channel};
}
sub check_ignore {
my $self = shift;
my ($nick, $user, $host, $channel) = @_;
$channel = lc $channel;
my $hostmask = "$nick!$user\@$host";
foreach my $ignored (keys %ignore_list) {
foreach my $ignored_channel (keys %{ $ignore_list{$ignored} }) {
$logger->log("check_ignore: comparing '$hostmask' against '$ignored' for channel '$channel'\n");
foreach my $ignored (keys %{ $self->{ignore_list} }) {
foreach my $ignored_channel (keys %{ ${ $self->{ignore_list} }{$ignored} }) {
$self->{pbot}->logger->log("check_ignore: comparing '$hostmask' against '$ignored' for channel '$channel'\n");
if(($channel =~ /$ignored_channel/i) && ($hostmask =~ /$ignored/i)) {
$logger->log("$nick!$user\@$host message ignored in channel $channel (matches [$ignored] host and [$ignored_channel] channel)\n");
$self->{pbot}->logger->log("$nick!$user\@$host message ignored in channel $channel (matches [$ignored] host and [$ignored_channel] channel)\n");
return 1;
}
}
}
return 0;
}
1;

105
PBot/IgnoreListCommands.pm Normal file
View File

@ -0,0 +1,105 @@
# File: IgnoreListCommands.pm
# Authoer: pragma_
#
# Purpose: Bot commands for interfacing with ignore list.
package PBot::IgnoreListCommands;
use warnings;
use strict;
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
use Time::HiRes qw(gettimeofday);
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to IgnoreListCommands should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to IgnoreListCommands");
}
$self->{pbot} = $pbot;
$pbot->commands->register(sub { return $self->ignore_user(@_) }, "ignore", 10);
$pbot->commands->register(sub { return $self->unignore_user(@_) }, "unignore", 10);
}
sub ignore_user {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Usage: ignore nick!user\@host [channel] [timeout]" if not defined $arguments;
my ($target, $channel, $length) = split /\s+/, $arguments;
if(not defined $target) {
return "/msg $nick Usage: ignore host [channel] [timeout]";
}
if($target =~ /^list$/i) {
my $text = "Ignored: ";
my $sep = "";
foreach my $ignored (keys %{ $self->{pbot}->ignorelist->{ignore_list} }) {
foreach my $channel (keys %{ ${ $self->{pbot}->ignorelist->{ignore_list} }{$ignored} }) {
$text .= $sep . "[$ignored][$channel]" . int(gettimeofday - ${ $self->{pbot}->ignorelist->{ignore_list} }{$ignored}{$channel});
$sep = "; ";
}
}
return "/msg $nick $text";
}
if(not defined $channel) {
$channel = ".*"; # all channels
}
if(not defined $length) {
$length = 300; # 5 minutes
}
$self->{pbot}->logger->log("$nick added [$target][$channel] to ignore list for $length seconds\n");
$self->{pbot}->ignorelist->add($target, $channel, $length);
return "/msg $nick [$target][$channel] added to ignore list for $length seconds";
}
sub unignore_user {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my ($target, $channel) = split /\s+/, $arguments;
if(not defined $target) {
return "/msg $nick Usage: unignore host [channel]";
}
if(not defined $channel) {
$channel = ".*";
}
if(not exists ${ $self->{pbot}->ignorelist->{ignore_list} }{$target}{$channel}) {
$self->{pbot}->logger->log("$nick attempt to remove nonexistent [$target][$channel] from ignore list\n");
return "/msg $nick [$target][$channel] not found in ignore list (use '!ignore list' to list ignores";
}
$self->{pbot}->ignorelist->remove($target, $channel);
$self->{pbot}->logger->log("$nick removed [$target][$channel] from ignore list\n");
return "/msg $nick [$target][$channel] unignored";
}
1;

667
PBot/InternalCommands.pm
View File

@ -1,667 +0,0 @@
package PBot::InternalCommands;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw(%flood_watch $logger %commands $conn %admins $botnick %internal_commands);
}
use vars @EXPORT_OK;
*flood_watch = \%PBot::AntiFlood::flood_watch;
*logger = \$PBot::PBot::logger;
*commands = \%PBot::FactoidStuff::commands;
*conn = \$PBot::PBot::conn;
*admins = \%PBot::BotAdminStuff::admins;
*botnick = \$PBot::PBot::botnick;
use Time::HiRes qw(gettimeofday);
#internal commands
# TODO: Move commands to respective module files
%internal_commands = (
alias => { sub => \&alias, level=> 0 },
add => { sub => \&add_text, level=> 0 },
regex => { sub => \&add_regex, level=> 0 },
learn => { sub => \&add_text, level=> 0 },
grab => { sub => \&PBot::Quotegrabs::quotegrab, level=> 0 },
delq => { sub => \&PBot::Quotegrabs::delete_quotegrab, level=> 40 },
getq => { sub => \&PBot::Quotegrabs::show_quotegrab, level=> 0 },
rq => { sub => \&PBot::Quotegrabs::show_random_quotegrab, level=> 0 },
info => { sub => \&info, level=> 0 },
show => { sub => \&show, level=> 0 },
histogram => { sub => \&histogram, level=> 0 },
top20 => { sub => \&top20, level=> 0 },
count => { sub => \&count, level=> 0 },
find => { sub => \&find, level=> 0 },
change => { sub => \&change_text, level=> 0 },
remove => { sub => \&remove_text, level=> 0 },
forget => { sub => \&remove_text, level=> 0 },
export => { sub => \&export, level=> 20 },
list => { sub => \&list, level=> 0 },
load => { sub => \&load_module, level=> 40 },
unload => { sub => \&unload_module, level=> 40 },
enable => { sub => \&enable_command, level=> 20 },
disable => { sub => \&disable_command, level=> 20 },
quiet => { sub => \&PBot::OperatorStuff::quiet, level=> 10 },
unquiet => { sub => \&PBot::OperatorStuff::unquiet, level=> 10 },
ignore => { sub => \&PBot::IgnoreList::ignore_user, level=> 10 },
unignore => { sub => \&PBot::IgnoreList::unignore_user, level=> 10 },
ban => { sub => \&PBot::OperatorStuff::ban_user, level=> 10 },
unban => { sub => \&PBot::OperatorStuff::unban_user, level=> 10 },
kick => { sub => \&PBot::OperatorStuff::kick_nick, level=> 10 },
login => { sub => \&login, level=> 0 },
logout => { sub => \&logout, level=> 0 },
join => { sub => \&join_channel, level=> 50 },
part => { sub => \&part_channel, level=> 50 },
addadmin => { sub => \&add_admin, level=> 40 },
deladmin => { sub => \&del_admin, level=> 40 },
die => { sub => \&ack_die, level=> 50 }
);
sub list {
my ($from, $nick, $user, $host, $arguments) = @_;
my $text;
if(not defined $arguments) {
return "/msg $nick Usage: list <modules|factoids|commands|admins>";
}
if($arguments =~/^messages\s+(.*?)\s+(.*)$/) {
my $nick_search = $1;
my $channel = $2;
if(not exists $flood_watch{$nick_search}) {
return "/msg $nick No messages for $nick_search yet.";
}
if(not exists $flood_watch{$nick_search}{$channel}) {
return "/msg $nick No messages for $nick_search in $channel yet.";
}
my @messages = @{ $flood_watch{$nick_search}{$channel}{messages} };
for(my $i = 0; $i <= $#messages; $i++) {
$conn->privmsg($nick, "" . ($i + 1) . ": " . $messages[$i]->{msg} . "\n") unless $nick =~ /\Q$botnick\E/i;
}
return "";
}
if($arguments =~ /^modules$/i) {
$text = "Loaded modules: ";
foreach my $command (sort keys %commands) {
if(exists $commands{$command}{module}) {
$text .= "$command ";
}
}
return $text;
}
if($arguments =~ /^commands$/i) {
$text = "Internal commands: ";
foreach my $command (sort keys %internal_commands) {
$text .= "$command ";
$text .= "($internal_commands{$command}{level}) "
if $internal_commands{$command}{level} > 0;
}
return $text;
}
if($arguments =~ /^factoids$/i) {
return "For a list of factoids see http://blackshell.com/~msmud/candide/factoids.html";
}
if($arguments =~ /^admins$/i) {
$text = "Admins: ";
foreach my $admin (sort { $admins{$b}{level} <=> $admins{$a}{level} } keys %admins) {
$text .= "*" if exists $admins{$admin}{login};
$text .= "$admin ($admins{$admin}{level}) ";
}
return $text;
}
return "/msg $nick Usage: list <modules|commands|factoids|admins>";
}
sub alias {
my ($from, $nick, $user, $host, $arguments) = @_;
my ($alias, $command) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $command) {
$logger->log("alias: invalid usage\n");
return "/msg $nick Usage: alias <keyword> <command>";
}
if(exists $commands{$alias}) {
$logger->log("attempt to overwrite existing command\n");
return "/msg $nick '$alias' already exists";
}
$commands{$alias}{text} = "/call $command";
$commands{$alias}{owner} = $nick;
$commands{$alias}{timestamp} = time();
$commands{$alias}{enabled} = 1;
$commands{$alias}{ref_count} = 0;
$commands{$alias}{ref_user} = "nobody";
$logger->log("$nick!$user\@$host aliased $alias => $command\n");
PBot::FactoidStuff::save_commands();
return "/msg $nick '$alias' aliases '$command'";
}
sub add_regex {
my ($from, $nick, $user, $host, $arguments) = @_;
my ($keyword, $text) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $keyword) {
$text = "";
foreach my $command (sort keys %commands) {
if(exists $commands{$command}{regex}) {
$text .= $command . " ";
}
}
return "Stored regexs: $text";
}
if(not defined $text) {
$logger->log("add_regex: invalid usage\n");
return "/msg $nick Usage: regex <regex> <command>";
}
if(exists $commands{$keyword}) {
$logger->log("$nick!$user\@$host attempt to overwrite $keyword\n");
return "/msg $nick $keyword already exists.";
}
$commands{$keyword}{regex} = $text;
$commands{$keyword}{owner} = $nick;
$commands{$keyword}{timestamp} = time();
$commands{$keyword}{enabled} = 1;
$commands{$keyword}{ref_count} = 0;
$commands{$keyword}{ref_user} = "nobody";
$logger->log("$nick!$user\@$host added [$keyword] => [$text]\n");
PBot::FactoidStuff::save_commands();
return "/msg $nick $keyword added.";
}
sub add_text {
my ($from, $nick, $user, $host, $arguments) = @_;
my ($keyword, $text) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $text) {
$logger->log("add_text: invalid usage\n");
return "/msg $nick Usage: add <keyword> <factoid>";
}
if(not defined $keyword) {
$logger->log("add_text: invalid usage\n");
return "/msg $nick Usage: add <keyword> <factoid>";
}
$text =~ s/^is\s+//;
if(exists $commands{$keyword}) {
$logger->log("$nick!$user\@$host attempt to overwrite $keyword\n");
return "/msg $nick $keyword already exists.";
}
$commands{$keyword}{text} = $text;
$commands{$keyword}{owner} = $nick;
$commands{$keyword}{timestamp} = time();
$commands{$keyword}{enabled} = 1;
$commands{$keyword}{ref_count} = 0;
$commands{$keyword}{ref_user} = "nobody";
$logger->log("$nick!$user\@$host added $keyword => $text\n");
PBot::FactoidStuff::save_commands();
return "/msg $nick $keyword added.";
}
sub histogram {
my ($from, $nick, $user, $host, $arguments) = @_;
my %hash;
my $factoids = 0;
foreach my $command (keys %commands) {
if(exists $commands{$command}{text}) {
$hash{$commands{$command}{owner}}++;
$factoids++;
}
}
my $text;
my $i = 0;
foreach my $owner (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
my $percent = int($hash{$owner} / $factoids * 100);
$percent = 1 if $percent == 0;
$text .= "$owner: $hash{$owner} ($percent". "%) ";
$i++;
last if $i >= 10;
}
return "$factoids factoids, top 10 submitters: $text";
}
sub show {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: show <factoid>";
}
if(not exists $commands{$arguments}) {
return "/msg $nick $arguments not found";
}
if(exists $commands{$arguments}{command} || exists $commands{$arguments}{module}) {
return "/msg $nick $arguments is not a factoid";
}
my $type;
$type = 'text' if exists $commands{$arguments}{text};
$type = 'regex' if exists $commands{$arguments}{regex};
return "$arguments: $commands{$arguments}{$type}";
}
sub info {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: info <factoid|module>";
}
if(not exists $commands{$arguments}) {
return "/msg $nick $arguments not found";
}
# factoid
if(exists $commands{$arguments}{text}) {
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) =
localtime($commands{$arguments}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
return "$arguments: Factoid submitted by $commands{$arguments}{owner} on $t, referenced $commands{$arguments}{ref_count} times (last by $commands{$arguments}{ref_user})";
}
# module
if(exists $commands{$arguments}{module}) {
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) =
localtime($commands{$arguments}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
return "$arguments: Module loaded by $commands{$arguments}{owner} on $t -> http://code.google.com/p/pbot2-pl/source/browse/trunk/modules/$commands{$arguments}{module}, used $commands{$arguments}{ref_count} times (last by $commands{$arguments}{ref_user})";
}
# regex
if(exists $commands{$arguments}{regex}) {
my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) =
localtime($commands{$arguments}{timestamp});
my $t = sprintf("%02d:%02d:%02d-%04d/%02d/%02d",
$hours, $minutes, $seconds, $year+1900, $month+1, $day_of_month);
return "$arguments: Regex created by $commands{$arguments}{owner} on $t, used $commands{$arguments}{ref_count} times (last by $commands{$arguments}{ref_user})";
}
return "/msg $nick $arguments is not a factoid or a module";
}
sub top20 {
my ($from, $nick, $user, $host, $arguments) = @_;
my %hash = ();
my $text = "";
my $i = 0;
if(not defined $arguments) {
foreach my $command (sort {$commands{$b}{ref_count} <=> $commands{$a}{ref_count}} keys %commands) {
if($commands{$command}{ref_count} > 0 && exists $commands{$command}{text}) {
$text .= "$command ($commands{$command}{ref_count}) ";
$i++;
last if $i >= 20;
}
}
$text = "Top $i referenced factoids: $text" if $i > 0;
return $text;
} else {
if(lc $arguments eq "recent") {
foreach my $command (sort { $commands{$b}{timestamp} <=> $commands{$a}{timestamp} } keys %commands) {
#my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) = localtime($commands{$command}{timestamp});
#my $t = sprintf("%04d/%02d/%02d", $year+1900, $month+1, $day_of_month);
$text .= "$command ";
$i++;
last if $i >= 50;
}
$text = "$i most recent submissions: $text" if $i > 0;
return $text;
}
my $user = lc $arguments;
foreach my $command (sort keys %commands) {
if($commands{$command}{ref_user} =~ /\Q$arguments\E/i) {
if($user ne lc $commands{$command}{ref_user} && not $user =~ /$commands{$command}{ref_user}/i) {
$user .= " ($commands{$command}{ref_user})";
}
$text .= "$command ";
$i++;
last if $i >= 20;
}
}
$text = "$i factoids last referenced by $user: $text" if $i > 0;
return $text;
}
}
sub count {
my ($from, $nick, $user, $host, $arguments) = @_;
my $i = 0;
my $total = 0;
if(not defined $arguments) {
return "/msg $nick Usage: count <nick|factoids>";
}
$arguments = ".*" if($arguments =~ /^factoids$/);
eval {
foreach my $command (keys %commands) {
$total++ if exists $commands{$command}{text};
my $regex = qr/^\Q$arguments\E$/;
if($commands{$command}{owner} =~ /$regex/i && exists $commands{$command}{text}) {
$i++;
}
}
};
return "/msg $nick $arguments: $@" if $@;
return "I have $i factoids" if($arguments eq ".*");
if($i > 0) {
my $percent = int($i / $total * 100);
$percent = 1 if $percent == 0;
return "$arguments has submitted $i factoids out of $total ($percent"."%)";
} else {
return "$arguments hasn't submitted any factoids";
}
}
sub find {
my ($from, $nick, $user, $host, $arguments) = @_;
my $i = 0;
my $text;
my $type;
foreach my $command (sort keys %commands) {
if(exists $commands{$command}{text} || exists $commands{$command}{regex}) {
$type = 'text' if(exists $commands{$command}{text});
$type = 'regex' if(exists $commands{$command}{regex});
$logger->log("Checking [$command], type: [$type]\n");
eval {
my $regex = qr/$arguments/;
if($commands{$command}{$type} =~ /$regex/i || $command =~ /$regex/i)
{
$i++;
$text .= "$command ";
}
};
return "/msg $nick $arguments: $@" if $@;
}
}
if($i == 1) {
chop $text;
$type = 'text' if exists $commands{$text}{text};
$type = 'regex' if exists $commands{$text}{regex};
return "found one match: '$text' is '$commands{$text}{$type}'";
} else {
return "$i factoids contain '$arguments': $text" unless $i == 0;
return "No factoids contain '$arguments'";
}
}
sub change_text {
$logger->log("Enter change_text\n");
my ($from, $nick, $user, $host, $arguments) = @_;
my ($keyword, $delim, $tochange, $changeto, $modifier);
if(defined $arguments) {
if($arguments =~ /^(.*?)\s+s(.)/) {
$keyword = $1;
$delim = $2;
}
if($arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/) {
$tochange = $1;
$changeto = $2;
$modifier = $3;
}
}
if(not defined $changeto) {
$logger->log("($from) $nick!$user\@$host: improper use of change\n");
return "/msg $nick Usage: change <keyword> s/<to change>/<change to>/";
}
if(not exists $commands{$keyword}) {
$logger->log("($from) $nick!$user\@$host: attempted to change nonexistant '$keyword'\n");
return "/msg $nick $keyword not found.";
}
my $type;
$type = 'text' if exists $commands{$keyword}{text};
$type = 'regex' if exists $commands{$keyword}{regex};
$logger->log("keyword: $keyword, type: $type, tochange: $tochange, changeto: $changeto\n");
my $ret = eval {
my $regex = qr/$tochange/;
if(not $commands{$keyword}{$type} =~ s|$regex|$changeto|) {
$logger->log("($from) $nick!$user\@$host: failed to change '$keyword' 's$delim$tochange$delim$changeto$delim\n");
return "/msg $nick Change $keyword failed.";
} else {
$logger->log("($from) $nick!$user\@$host: changed '$keyword' 's/$tochange/$changeto/\n");
PBot::FactoidStuff::save_commands();
return "Changed: $keyword is $commands{$keyword}{$type}";
}
};
return "/msg $nick Change $keyword: $@" if $@;
return $ret;
}
sub remove_text {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
$logger->log("remove_text: invalid usage\n");
return "/msg $nick Usage: remove <keyword>";
}
$logger->log("Attempting to remove [$arguments]\n");
if(not exists $commands{$arguments}) {
return "/msg $nick $arguments not found.";
}
if(exists $commands{$arguments}{command} || exists $commands{$arguments}{module}) {
$logger->log("$nick!$user\@$host attempted to remove $arguments [not factoid]\n");
return "/msg $nick $arguments is not a factoid.";
}
if(($nick ne $commands{$arguments}{owner}) and (not PBot::BotAdminStuff::loggedin($nick, $host))) {
$logger->log("$nick!$user\@$host attempted to remove $arguments [not owner]\n");
return "/msg $nick You are not the owner of '$arguments'";
}
$logger->log("$nick!$user\@$host removed [$arguments][$commands{$arguments}{text}]\n") if(exists $commands{$arguments}{text});
$logger->log("$nick!$user\@$host removed [$arguments][$commands{$arguments}{regex}]\n") if(exists $commands{$arguments}{regex});
delete $commands{$arguments};
PBot::FactoidStuff::save_commands();
return "/msg $nick $arguments removed.";
}
sub load_module {
my ($from, $nick, $user, $host, $arguments) = @_;
my ($keyword, $module) = $arguments =~ /^(.*?)\s+(.*)$/ if defined $arguments;
if(not defined $arguments) {
return "/msg $nick Usage: load <command> <module>";
}
if(not exists($commands{$keyword})) {
$commands{$keyword}{module} = $module;
$commands{$keyword}{enabled} = 1;
$commands{$keyword}{owner} = $nick;
$commands{$keyword}{timestamp} = time();
$logger->log("$nick!$user\@$host loaded $keyword => $module\n");
PBot::FactoidStuff::save_commands();
return "/msg $nick Loaded $keyword => $module";
} else {
return "/msg $nick There is already a command named $keyword.";
}
}
sub unload_module {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: unload <module>";
} elsif(not exists $commands{$arguments}) {
return "/msg $nick $arguments not found.";
} elsif(not exists $commands{$arguments}{module}) {
return "/msg $nick $arguments is not a module.";
} else {
delete $commands{$arguments};
PBot::FactoidStuff::save_commands();
$logger->log("$nick!$user\@$host unloaded module $arguments\n");
return "/msg $nick $arguments unloaded.";
}
}
sub enable_command {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: enable <command>";
} elsif(not exists $commands{$arguments}) {
return "/msg $nick $arguments not found.";
} else {
$commands{$arguments}{enabled} = 1;
PBot::FactoidStuff::save_commands();
$logger->log("$nick!$user\@$host enabled $arguments\n");
return "/msg $nick $arguments enabled.";
}
}
sub disable_command {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: disable <command>";
} elsif(not exists $commands{$arguments}) {
return "/msg $nick $arguments not found.";
} else {
$commands{$arguments}{enabled} = 0;
PBot::FactoidStuff::save_commands();
$logger->log("$nick!$user\@$host disabled $arguments\n");
return "/msg $nick $arguments disabled.";
}
}
sub login {
my ($from, $nick, $user, $host, $arguments) = @_;
if(PBot::BotAdminStuff::loggedin($nick, $host)) {
return "/msg $nick You are already logged in.";
}
if(not exists $admins{$nick}) {
$logger->log("$nick!$user\@$host attempted to login without account.\n");
return "/msg $nick You do not have an account.";
}
if($admins{$nick}{password} eq $arguments && $host =~ /$admins{$nick}{host}/i) {
$admins{$nick}{login} = 1;
$logger->log("$nick!$user\@$host logged in.\n");
return "/msg $nick Welcome $nick, how may I help you?";
} else {
$logger->log("$nick!$user\@$host received wrong password.\n");
return "/msg $nick I don't think so.";
}
}
sub logout {
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Uh, you aren't logged in." if(not PBot::BotAdminStuff::loggedin($nick, $host));
delete $admins{$nick}{login};
$logger->log("$nick!$user\@$host logged out.\n");
return "/msg $nick Good-bye, $nick.";
}
sub add_admin {
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Coming soon.";
}
sub del_admin {
my ($from, $nick, $user, $host, $arguments) = @_;
return "/msg $nick Coming soon.";
}
sub join_channel {
my ($from, $nick, $user, $host, $arguments) = @_;
# FIXME -- update %channels hash?
$logger->log("$nick!$user\@$host made me join $arguments\n");
$conn->join($arguments);
return "/msg $nick Joined $arguments";
}
sub part_channel {
my ($from, $nick, $user, $host, $arguments) = @_;
# FIXME -- update %channels hash?
$logger->log("$nick!$user\@$host made me part $arguments\n");
$conn->part($arguments);
return "/msg $nick Parted $arguments";
}
sub ack_die {
my ($from, $nick, $user, $host, $arguments) = @_;
$logger->log("$nick!$user\@$host made me exit.\n");
PBot::FactoidStuff::save_commands();
$conn->privmsg($from, "Good-bye.") if defined $from;
$conn->quit("Departure requested.");
exit 0;
}
sub export {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $arguments) {
return "/msg $nick Usage: export <modules|factoids|admins>";
}
if($arguments =~ /^modules$/i) {
return "/msg $nick Coming soon.";
}
if($arguments =~ /^quotegrabs$/i) {
return PBot::Quotegrabs::export_quotegrabs();
}
if($arguments =~ /^factoids$/i) {
return PBot::Factoids::export_factoids();
}
if($arguments =~ /^admins$/i) {
return "/msg $nick Coming soon.";
}
}
1;

368
PBot/Interpreter.pm
View File

@ -1,49 +1,61 @@
# File: Interpreter.pm
# Authoer: pragma_
# Author: pragma_
#
# Purpose: Parses a single line of input and takes appropriate action.
# Purpose:
package PBot::Interpreter;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
use base 'PBot::Registerable';
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($conn $MAX_FLOOD_MESSAGES $FLOOD_CHAT $logger %commands $botnick %admins %internal_commands
$max_msg_len $last_timestamp $flood_msg);
use Carp ();
BEGIN {
use vars qw($VERSION);
$VERSION = '1.0.0';
}
use vars @EXPORT_OK;
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Interpreter should be key/value pairs, not hash reference");
}
use Time::HiRes qw(gettimeofday);
my ($class, %conf) = @_;
*logger = \$PBot::PBot::logger;
*conn = \$PBot::PBot::conn;
*commands = \%PBot::FactoidStuff::commands;
*botnick = \$PBot::PBot::botnick;
*admins = \%PBot::BotAdminStuff::admins;
*internal_commands = \%PBot::InternalCommands::internal_commands;
*max_msg_len = \$PBot::PBot::max_msg_len;
*last_timestamp = \$PBot::AntiFlood::last_timestamp;
*flood_msg = \$PBot::AntiFlood::flood_msg;
*FLOOD_CHAT = \$PBot::AntiFlood::FLOOD_CHAT;
*MAX_FLOOD_MESSAGES = \$PBot::PBot::MAX_FLOOD_MESSAGES;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
$self->SUPER::initialize(%conf);
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to PBot::Interpreter");
}
$self->{pbot} = $pbot;
}
sub process_line {
my $self = shift;
my ($from, $nick, $user, $host, $text) = @_;
my ($command, $args, $result);
my $has_url = undef;
my $mynick = $conn->nick;
my $mynick = $self->pbot->botnick;
$from = lc $from if defined $from;
PBot::AntiFlood::check_flood($from, $nick, $user, $host, $text, $MAX_FLOOD_MESSAGES, $FLOOD_CHAT) if defined $from;
my $pbot = $self->pbot;
$pbot->antiflood->check_flood($from, $nick, $user, $host, $text, $pbot->{MAX_FLOOD_MESSAGES}, $pbot->{FLOOD_CHAT}) if defined $from;
if($text =~ /^.?$mynick.?\s+(.*?)([\?!]*)$/i) {
$command = "$1";
@ -57,93 +69,77 @@ sub process_line {
if(defined $command || defined $has_url) {
if((defined $command && $command !~ /^login/i) || defined $has_url) {
$logger->log("ignored text: [$nick][$host][$from][$text]\n") and return if(defined $from && PBot::IgnoreList::check_ignore($nick, $user, $host, $from) && not PBot::BotAdminStuff::loggedin($nick, $host)); # ignored host
}
my $now = gettimeofday;
if(defined $from) { # do not execute following if text is coming from STDIN ($from undef)
if($from =~ /^#/) {
$flood_msg++;
$logger->log("flood_msg: $flood_msg\n");
}
if($flood_msg > 3) {
$logger->log("flood_msg exceeded! [$flood_msg]\n");
PBot::IgnoreList::ignore_user("", "floodcontrol", "", ".* $from 300");
$flood_msg = 0;
if($from =~ /^#/) {
$conn->me($from, "has been overwhelmed.");
$conn->me($from, "lies down and falls asleep.");
return;
}
}
if($now - $last_timestamp >= 15) {
$last_timestamp = $now;
if($flood_msg > 0) {
$logger->log("flood_msg reset: (was $flood_msg)\n");
$flood_msg = 0;
}
if(defined $from && $pbot->ignorelist->check_ignore($nick, $user, $host, $from) && not $pbot->admins->loggedin($from, "$nick!$user\@$host")) {
# ignored hostmask
$pbot->logger->log("ignored text: [$from][$nick!$user\@$host\[$text\]\n");
return;
}
}
if(not defined $has_url) {
$result = interpret_command($from, $nick, $user, $host, 1, $command);
$result = $self->interpret($from, $nick, $user, $host, 1, $command);
} else {
$result = PBot::Modules::execute_module($from, undef, $nick, $user, $host, "title", "$nick http://$has_url");
$result = $self->{pbot}->factoids->{factoidmodulelauncher}->execute_module($from, undef, $nick, $user, $host, "title", "$nick http://$has_url");
}
$result =~ s/\$nick/$nick/g;
$result =~ s/\$nick/$nick/g if defined $result;
# TODO add paging system?
if(defined $result && length $result > 0) {
my $len = length $result;
if($len > $max_msg_len) {
if(($len - $max_msg_len) > 10) {
$logger->log("Message truncated.\n");
$result = substr($result, 0, $max_msg_len);
substr($result, $max_msg_len) = "... (" . ($len - $max_msg_len) . " more characters)";
if($len > $pbot->max_msg_len) {
if(($len - $pbot->max_msg_len) > 10) {
$pbot->logger->log("Message truncated.\n");
$result = substr($result, 0, $pbot->max_msg_len);
substr($result, $pbot->max_msg_len) = "... (" . ($len - $pbot->max_msg_len) . " more characters)";
}
}
$logger->log("Final result: $result\n");
$pbot->logger->log("Final result: $result\n");
if($result =~ s/^\/me\s+//i) {
$conn->me($from, $result) if defined $from && $from !~ /\Q$botnick\E/i;
$pbot->conn->me($from, $result) if defined $from && $from !~ /\Q$mynick\E/i;
} elsif($result =~ s/^\/msg\s+([^\s]+)\s+//i) {
my $to = $1;
if($to =~ /.*serv$/i) {
$logger->log("[HACK] Possible HACK ATTEMPT /msg *serv: [$nick!$user\@$host] [$command] [$result]\n");
$pbot->logger->log("[HACK] Possible HACK ATTEMPT /msg *serv: [$nick!$user\@$host] [$command] [$result]\n");
}
elsif($result =~ s/^\/me\s+//i) {
$conn->me($to, $result) if $to !~ /\Q$botnick\E/i;
$pbot->conn->me($to, $result) if $to !~ /\Q$mynick\E/i;
} else {
$result =~ s/^\/say\s+//i;
$conn->privmsg($to, $result) if $to !~ /\Q$botnick\E/i;
$pbot->conn->privmsg($to, $result) if $to !~ /\Q$mynick\E/i;
}
} else {
$conn->privmsg($from, $result) if defined $from && $from !~ /\Q$botnick\E/i;
$pbot->conn->privmsg($from, $result) if defined $from && $from !~ /\Q$mynick\E/i;
}
}
$logger->log("---------------------------------------------\n");
exit if($PBot::Modules::child != 0); # if this process is a child, it must die now
$pbot->logger->log("---------------------------------------------\n");
# TODO: move this to FactoidModuleLauncher somehow, completely out of Interpreter!
if($pbot->factoids->{factoidmodulelauncher}->{child} != 0) {
# if this process is a child, it must die now
#$pbot->logger->log("Terminating module.\n");
exit;
}
}
}
sub interpret_command {
sub interpret {
my $self = shift;
my ($from, $nick, $user, $host, $count, $command) = @_;
my ($keyword, $arguments, $tonick);
my $text;
my $pbot = $self->pbot;
$logger->log("=== Enter interpret_command: [" . (defined $from ? $from : "(undef)") . "][$nick!$user\@$host][$count][$command]\n");
$pbot->logger->log("=== Enter interpret_command: [" . (defined $from ? $from : "(undef)") . "][$nick!$user\@$host][$count][$command]\n");
return "Too many levels of recursion, aborted." if(++$count > 5);
if(not defined $nick || not defined $user || not defined $host ||
not defined $command) {
$logger->log("Error 1, bad parameters to interpret_command\n");
return "";
$pbot->logger->log("Error 1, bad parameters to interpret_command\n");
return undef;
}
if($command =~ /^tell\s+(.{1,20})\s+about\s+(.*?)\s+(.*)$/i)
@ -154,8 +150,8 @@ sub interpret_command {
} elsif($command =~ /^([^ ]+)\s+is\s+also\s+(.*)$/) {
($keyword, $arguments) = ("change", "$1 s,\$, ; $2,");
} elsif($command =~ /^([^ ]+)\s+is\s+(.*)$/) {
($keyword, $arguments) = ("add", join(' ', $1, $2)) unless exists $commands{$1};
($keyword, $arguments) = ($1, "is $2") if exists $commands{$1};
($keyword, $arguments) = ("add", join(' ', $1, $2)) unless exists ${ $pbot->factoids }{$1};
($keyword, $arguments) = ($1, "is $2") if exists ${ $pbot->factoids }{$1};
} elsif($command =~ /^(.*?)\s+(.*)$/) {
($keyword, $arguments) = ($1, $2);
} else {
@ -165,230 +161,24 @@ sub interpret_command {
$arguments =~ s/\bme\b/\$nick/gi if defined $arguments;
$arguments =~ s/\/\$nick/\/me/gi if defined $arguments;
$logger->log("keyword: [$keyword], arguments: [" . (defined $arguments ? $arguments : "(undef)") . "], tonick: [" . (defined $tonick ? $tonick : "(undef)") . "]\n");
$pbot->logger->log("keyword: [$keyword], arguments: [" . (defined $arguments ? $arguments : "(undef)") . "], tonick: [" . (defined $tonick ? $tonick : "(undef)") . "]\n");
if(defined $arguments && $arguments =~ m/\b(your|him|her|its|it|them|their)(self|selves)\b/i) {
return "Why would I want to do that to myself?";
}
if(not defined $keyword) {
$logger->log("Error 2, no keyword\n");
return "";
$pbot->logger->log("Error 2, no keyword\n");
return undef;
}
# Check if it's an alias
if(exists $commands{$keyword} and exists $commands{$keyword}{text}) {
if($commands{$keyword}{text} =~ /^\/call\s+(.*)$/) {
if(defined $arguments) {
$command = "$1 $arguments";
} else {
$command = $1;
}
$logger->log("Command aliased to: [$command]\n");
return $self->SUPER::execute_all($from, $nick, $user, $host, $count, $keyword, $arguments, $tonick);
}
$commands{$keyword}{ref_count}++;
$commands{$keyword}{ref_user} = $nick;
return interpret_command($from, $nick, $user, $host, $count, $command);
}
}
#$logger->log("Checking internal commands\n");
# First, we check internal commands
foreach $command (keys %internal_commands) {
if($keyword =~ /^$command$/i) {
$keyword = lc $keyword;
if($internal_commands{$keyword}{level} > 0) {
return "/msg $nick You must login to use this command."
if not PBot::BotAdminStuff::loggedin($nick, $host);
return "/msg $nick Your access level of $admins{$nick}{level} is not sufficent to use this command."
if $admins{$nick}{level} < $internal_commands{$keyword}{level};
}
$logger->log("(" . (defined $from ? $from : "(undef)") . "): $nick!$user\@$host Executing internal command: $keyword " . (defined $arguments ? $arguments : "") . "\n");
return $internal_commands{$keyword}{sub}($from, $nick, $user, $host, $arguments);
}
}
#$logger->log("Checking bot commands\n");
# Then, we check bot commands
foreach $command (keys %commands) {
my $lc_command = lc $command;
if(lc $keyword =~ m/^\Q$lc_command\E$/i) {
$logger->log("=======================\n");
$logger->log("[$keyword] == [$command]\n");
if($commands{$command}{enabled} == 0) {
$logger->log("$command disabled.\n");
return "$command is currently disabled.";
} elsif(exists $commands{$command}{module}) {
$logger->log("Found module\n");
$commands{$keyword}{ref_count}++;
$commands{$keyword}{ref_user} = $nick;
$text = PBot::Modules::execute_module($from, $tonick, $nick, $user, $host, $keyword, $arguments);
return $text;
}
elsif(exists $commands{$command}{text}) {
$logger->log("Found factoid\n");
# Don't allow user-custom /msg factoids, unless factoid triggered by admin
if(($commands{$command}{text} =~ m/^\/msg/i) and (not PBot::BotAdminStuff::loggedin($nick, $host))) {
$logger->log("[HACK] Bad factoid (contains /msg): $commands{$command}{text}\n");
return "You must login to use this command."
}
$commands{$command}{ref_count}++;
$commands{$command}{ref_user} = $nick;
$logger->log("(" . (defined $from ? $from : "(undef)") . "): $nick!$user\@$host): $command: Displaying text \"$commands{$command}{text}\"\n");
if(defined $tonick) { # !tell foo about bar
$logger->log("($from): $nick!$user\@$host) sent to $tonick\n");
my $fromnick = PBot::BotAdminStuff::loggedin($nick, $host) ? "" : "$nick wants you to know: ";
$text = $commands{$command}{text};
if($text =~ s/^\/say\s+//i || $text =~ s/^\/me\s+/* $botnick /i
|| $text =~ /^\/msg\s+/i) {
$text = "/msg $tonick $fromnick$text";
} else {
$text = "/msg $tonick $fromnick$command is $text";
}
$logger->log("text set to [$text]\n");
} else {
$text = $commands{$command}{text};
}
if(defined $arguments) {
$logger->log("got arguments: [$arguments]\n");
# TODO - extract and remove $tonick from end of $arguments
if(not $text =~ s/\$args/$arguments/gi) {
$logger->log("factoid doesn't take argument, checking ...\n");
# factoid doesn't take an argument
if($arguments =~ /^[^ ]{1,20}$/) {
# might be a nick
$logger->log("could be nick\n");
if($text =~ /^\/.+? /) {
$text =~ s/^(\/.+?) /$1 $arguments: /;
} else {
$text =~ s/^/\/say $arguments: $command is / unless (defined $tonick);
}
} else {
if($text !~ /^\/.+? /) {
$text =~ s/^/\/say $command is / unless (defined $tonick);
}
}
$logger->log("updated text: [$text]\n");
}
$logger->log("replaced \$args: [$text]\n");
} else {
# no arguments supplied
$text =~ s/\$args/$nick/gi;
}
$text =~ s/\$nick/$nick/g;
while($text =~ /[^\\]\$([^\s!+.$\/\\,;=&]+)/g) {
my $var = $1;
#$logger->log("adlib: got [$var]\n");
#$logger->log("adlib: parsing variable [\$$var]\n");
if(exists $commands{$var} && exists $commands{$var}{text}) {
my $change = $commands{$var}{text};
my @list = split(/\s|(".*?")/, $change);
my @mylist;
#$logger->log("adlib: list [". join(':', @mylist) ."]\n");
for(my $i = 0; $i <= $#list; $i++) {
#$logger->log("adlib: pushing $i $list[$i]\n");
push @mylist, $list[$i] if $list[$i];
}
my $line = int(rand($#mylist + 1));
$mylist[$line] =~ s/"//g;
$text =~ s/\$$var/$mylist[$line]/;
#$logger->log("adlib: found: change: $text\n");
} else {
$text =~ s/\$$var/$var/g;
#$logger->log("adlib: not found: change: $text\n");
}
}
$text =~ s/\\\$/\$/g;
# $logger->log("finally... [$text]\n");
if($text =~ s/^\/say\s+//i || $text =~ /^\/me\s+/i
|| $text =~ /^\/msg\s+/i) {
# $logger->log("ret1\n");
return $text;
} else {
# $logger->log("ret2\n");
return "$command is $text";
}
$logger->log("unknown3: [$text]\n");
} else {
$logger->log("($from): $nick!$user\@$host): Unknown command type for '$command'\n");
return "/me blinks.";
}
$logger->log("unknown4: [$text]\n");
} # else no match
} # end foreach
#$logger->log("Checking regex factoids\n");
# Otherwise, the command was not found.
# Lets try regexp factoids ...
my $string = "$keyword" . (defined $arguments ? " $arguments" : "");
foreach my $command (sort keys %commands) {
if(exists $commands{$command}{regex}) {
eval {
my $regex = qr/$command/i;
# $logger->log("testing $string =~ $regex\n");
if($string =~ $regex) {
$logger->log("[$string] matches [$command][$regex] - calling [" . $commands{$command}{regex}. "$']\n");
my $cmd = "$commands{$command}{regex}$'";
my $a = $1;
my $b = $2;
my $c = $3;
my $d = $4;
my $e = $5;
my $f = $6;
my $g = $7;
my $h = $8;
my $i = $9;
my $before = $`;
my $after = $';
$cmd =~ s/\$1/$a/g;
$cmd =~ s/\$2/$b/g;
$cmd =~ s/\$3/$c/g;
$cmd =~ s/\$4/$d/g;
$cmd =~ s/\$5/$e/g;
$cmd =~ s/\$6/$f/g;
$cmd =~ s/\$7/$g/g;
$cmd =~ s/\$8/$h/g;
$cmd =~ s/\$9/$i/g;
$cmd =~ s/\$`/$before/g;
$cmd =~ s/\$'/$after/g;
$cmd =~ s/^\s+//;
$cmd =~ s/\s+$//;
$text = interpret_command($from, $nick, $user, $host, $count, $cmd);
return $text;
}
};
if($@) {
$logger->log("Regex fail: $@\n");
return "/msg $nick Fail.";
}
}
}
$logger->log("[$keyword] not found.\n");
return "";
sub pbot {
my $self = shift;
if(@_) { $self->{pbot} = shift; }
return $self->{pbot};
}
1;

1
PBot/Logger.pm
View File

@ -4,7 +4,6 @@ use warnings;
use strict;
use vars qw($VERSION);
$VERSION = '1.0.0';
use Carp ();

75
PBot/Modules.pm
View File

@ -1,75 +0,0 @@
# File: Modules.pm
# Authoer: pragma_
#
# Purpose: Handles forking and execution of module processes
package PBot::Modules;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($child %commands $logger $module_dir);
}
use vars @EXPORT_OK;
*commands = \%PBot::InternalCommands::commands;
*logger = \$PBot::PBot::logger;
*module_dir = \$PBot::PBot::module_dir;
use POSIX qw(WNOHANG); # for children process reaping
# automatically reap children processes in background
$SIG{CHLD} = sub { while(waitpid(-1, WNOHANG) > 0) {} };
$child = 0; # determines whether process is child
sub execute_module {
my ($from, $tonick, $nick, $user, $host, $keyword, $arguments) = @_;
my $text;
$arguments = "" if not defined $arguments;
$logger->log("(" . (defined $from ? $from : "(undef)") . "): $nick!$user\@$host: Executing module $commands{$keyword}{module} $arguments\n");
$arguments = quotemeta($arguments);
$arguments =~ s/\\\s+/ /;
my $pid = fork;
if(not defined $pid) {
$logger->log("Could not fork module: $!\n");
return "/me groans loudly.";
}
# FIXME -- add check to ensure $commands{$keyword}{module} exists
if($pid == 0) { # start child block
$child = 1; # set to be killed after returning
if(defined $tonick) {
$logger->log("($from): $nick!$user\@$host) sent to $tonick\n");
$text = `$module_dir/$commands{$keyword}{module} $arguments`;
my $fromnick = PBot::BotAdminStuff::loggedin($nick, $host) ? "" : " ($nick)";
#return "/msg $tonick $text$fromnick"; # send private message to user
if(defined $text && length $text > 0) {
return "$tonick: $text";
} else {
return "";
}
} else {
return `$module_dir/$commands{$keyword}{module} $arguments`;
}
return "/me moans loudly."; # er, didn't execute the module?
} # end child block
return ""; # child returns bot command, not parent -- so return blank/no command
}
1;

30
PBot/NewModule.pm
View File

@ -1,5 +1,5 @@
# File: NewModule.pm
# Authoer: pragma_
# Author: pragma_
#
# Purpose: New module skeleton
@ -9,16 +9,10 @@ use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw();
}
use vars @EXPORT_OK;
use Carp ();
sub new {
@ -28,22 +22,22 @@ sub new {
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $option = delete $conf{option};
$option = 10 unless defined $option; # set to default value unless defined
if(defined $option) {
# do something (optional)
} else {
# set default value (optional)
$option = undef;
}
my $self = {
option => $option,
};
bless $self, $class;
return $self;
$self->{option} = $option;
}
# subs here

222
PBot/OperatorStuff.pm
View File

@ -1,222 +0,0 @@
# File: NewModule.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
package PBot::OperatorStuff;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw($logger $conn $botnick %quieted_nicks %unban_timeout @op_commands %is_opped);
}
use vars @EXPORT_OK;
use Time::HiRes qw(gettimeofday);
*logger = \$PBot::PBot::logger;
*conn = \$PBot::PBot::conn;
*botnick = \$PBot::PBot::botnick;
%quieted_nicks = ();
%unban_timeout = ();
@op_commands = ();
%is_opped = ();
sub gain_ops {
my $channel = shift;
if(not exists $is_opped{$channel}) {
$conn->privmsg("chanserv", "op $channel");
} else {
perform_op_commands();
}
}
sub lose_ops {
my $channel = shift;
$conn->privmsg("chanserv", "op $channel -$botnick");
if(exists $is_opped{$channel}) {
$is_opped{$channel}{timeout} = gettimeofday + 60; # try again in 1 minute if failed
}
}
sub perform_op_commands {
$logger->log("Performing op commands...\n");
foreach my $command (@op_commands) {
if($command =~ /^mode (.*?) (.*)/i) {
$conn->mode($1, $2);
$logger->log(" executing mode $1 $2\n");
} elsif($command =~ /^kick (.*?) (.*?) (.*)/i) {
$conn->kick($1, $2, $3) unless $1 =~ /\Q$botnick\E/i;
$logger->log(" executing kick on $1 $2 $3\n");
}
shift(@op_commands);
}
$logger->log("Done.\n");
}
# TODO: move internal commands to OperatorCommands.pm?
sub quiet {
my ($from, $nick, $user, $host, $arguments) = @_;
my ($target, $length) = split(/\s+/, $arguments);
if(not defined $from) {
$logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
return "/msg $nick This command must be used in the channel.";
}
if(not defined $target) {
return "/msg $nick Usage: quiet nick [timeout seconds (default: 3600 or 1 hour)]";
}
if(not defined $length) {
$length = 60 * 60; # one hour
}
return "" if $target =~ /\Q$botnick\E/i;
quiet_nick_timed($target, $from, $length);
$conn->privmsg($target, "$nick has quieted you for $length seconds.");
}
sub unquiet {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
return "/msg $nick This command must be used in the channel.";
}
if(not defined $arguments) {
return "/msg $nick Usage: unquiet nick";
}
unquiet_nick($arguments, $from);
delete $quieted_nicks{$arguments};
$conn->privmsg($arguments, "$nick has allowed you to speak again.") unless $arguments =~ /\Q$botnick\E/i;
}
sub quiet_nick {
my ($nick, $channel) = @_;
unshift @op_commands, "mode $channel +q $nick!*@*";
gain_ops($channel);
}
sub unquiet_nick {
my ($nick, $channel) = @_;
unshift @op_commands, "mode $channel -q $nick!*@*";
gain_ops($channel);
}
sub quiet_nick_timed {
my ($nick, $channel, $length) = @_;
quiet_nick($nick, $channel);
$quieted_nicks{$nick}{time} = gettimeofday + $length;
$quieted_nicks{$nick}{channel} = $channel;
}
# TODO: need to refactor ban_user() and unban_user() - mostly duplicate code
sub ban_user {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
if($arguments =~ /^(#.*?) (.*?) (.*)$/) {
$conn->privmsg("ChanServ", "AUTOREM $1 ADD $2 $3");
unshift @op_commands, "kick $1 $2 Banned";
gain_ops($1);
$logger->log("$nick!$user\@$host AUTOREM $2 ($3)\n");
return "/msg $nick $2 added to auto-remove";
} else {
$logger->log("$nick!$user\@$host: bad format for ban in msg\n");
return "/msg $nick Usage (in msg mode): !ban <channel> <hostmask> <reason>";
}
} else { #in a channel
if($arguments =~ /^(.*?) (.*)$/) {
$conn->privmsg("ChanServ", "AUTOREM $from ADD $1 $2");
$logger->log("AUTOREM [$from] ADD [$1] [$2]\n");
$logger->log("kick [$from] [$1] Banned\n");
unshift @op_commands, "kick $from $1 Banned";
gain_ops($from);
$logger->log("$nick ($from) AUTOREM $1 ($2)\n");
return "/msg $nick $1 added to auto-remove";
} else {
$logger->log("$nick!$user\@$host: bad format for ban in channel\n");
return "/msg $nick Usage (in channel mode): !ban <hostmask> <reason>";
}
}
}
sub unban_user {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) { #not a channel
if($arguments =~ /^(#.*?) (.*)$/) {
$conn->privmsg("ChanServ", "AUTOREM $1 DEL $2");
unshift @op_commands, "mode $1 -b $2";
gain_ops($1);
delete $unban_timeout{$2};
$logger->log("$nick!$user\@$host AUTOREM DEL $2 ($3)\n");
return "/msg $nick $2 removed from auto-remove";
} else {
$logger->log("$nick!$user\@$host: bad format for unban in msg\n");
return "/msg $nick Usage (in msg mode): !unban <channel> <hostmask>";
}
} else { #in a channel
$conn->privmsg("ChanServ", "AUTOREM $from DEL $arguments");
unshift @op_commands, "mode $from -b $arguments";
gain_ops($from);
delete $unban_timeout{$arguments};
$logger->log("$nick!$user\@$host AUTOREM DEL $arguments\n");
return "/msg $nick $arguments removed from auto-remove";
}
}
sub kick_nick {
my ($from, $nick, $user, $host, $arguments) = @_;
if(not defined $from) {
$logger->log("Command missing ~from parameter!\n");
return "";
}
if(not $from =~ /^#/) {
$logger->log("$nick!$user\@$host attempted to /msg kick\n");
return "/msg $nick Kick must be used in the channel.";
}
if(not $arguments =~ /(.*?) (.*)/) {
$logger->log("$nick!$user\@$host: invalid arguments to kick\n");
return "/msg $nick Usage: !kick <nick> <reason>";
}
unshift @op_commands, "kick $from $1 $2";
gain_ops($from);
}
1;

402
PBot/PBot.pm
View File

@ -9,51 +9,41 @@ use strict;
use warnings;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = "0.5.0-beta";
@ISA = qw(Exporter);
# TODO: move all of these into the pbot object and pass that around instead
@EXPORT_OK = qw($VERSION %flood_watch $logger %commands $conn %admins $botnick %internal_commands
%is_opped @op_commands %quieted_nicks %ignore_list %unban_timeout @quotegrabs
$channels_file $MAX_NICK_MESSAGES %flood_watch $quotegrabs_file $export_quotegrabs_path $export_quotegrabs_timeout
$commands_file $module_dir $admins_file $export_factoids_timeout $export_factoids_path $max_msg_len
$export_factoids_time $export_quotegrabs_time $MAX_FLOOD_MESSAGES $identify_password);
use vars qw($VERSION);
$VERSION = "0.6.0-beta";
}
use vars @EXPORT_OK;
# unbuffer stdout
STDOUT->autoflush(1);
use Net::IRC; # for the main IRC engine
use HTML::Entities; # for exporting
use Time::HiRes qw(gettimeofday alarm); # for timers
use Carp ();
use Data::Dumper;
use PBot::Logger;
use PBot::IRCHandlers;
use PBot::InternalCommands;
use PBot::ChannelStuff;
use PBot::StdinReader;
use PBot::Quotegrabs;
use PBot::FactoidStuff;
use PBot::Interpreter;
use PBot::IgnoreList;
use PBot::BotAdminStuff;
use PBot::Modules;
use Net::IRC;
use PBot::IRCHandlers;
use PBot::AntiFlood;
use PBot::OperatorStuff;
use PBot::TimerStuff;
use PBot::Interpreter;
use PBot::Commands;
*admins = \%PBot::BotAdminStuff::admins;
*commands = \%PBot::FactoidStuff::commands;
*quotegrabs = \@PBot::Quotegrabs::quotegrabs;
use PBot::ChanOps;
use PBot::Channels;
# TODO: Move these into pbot object
my $ircserver;
use PBot::Quotegrabs;
#use PBot::QuotegrabCommands;
use PBot::Factoids;
use PBot::FactoidCommands;
use PBot::BotAdmins;
use PBot::BotAdminCommands;
use PBot::IgnoreList;
use PBot::IgnoreListCommands;
use PBot::Timer;
sub new {
if(ref($_[1]) eq 'HASH') {
@ -62,127 +52,174 @@ sub new {
my ($class, %conf) = @_;
my $log_file = delete $conf{log_file};
# TODO: Move all of these into pbot object
$channels_file = delete $conf{channels_file};
$commands_file = delete $conf{commands_file};
$quotegrabs_file = delete $conf{quotegrabs_file};
$admins_file = delete $conf{admins_file};
$module_dir = delete $conf{module_dir};
$ircserver = delete $conf{ircserver};
$botnick = delete $conf{botnick};
$identify_password = delete $conf{identify_password};
$max_msg_len = delete $conf{max_msg_len};
$export_factoids_timeout = delete $conf{export_factoids_timeout};
$export_factoids_path = delete $conf{export_factoids_path};
$export_quotegrabs_timeout = delete $conf{export_quotegrabs_timeout};
$export_quotegrabs_path = delete $conf{export_quotegrabs_path};
$MAX_FLOOD_MESSAGES = delete $conf{MAX_FLOOD_MESSAGES};
$MAX_NICK_MESSAGES = delete $conf{MAX_NICK_MESSAGES};
my $home = $ENV{HOME};
$channels_file = "$home/pbot/channels" unless defined $channels_file;
$commands_file = "$home/pbot/commands" unless defined $commands_file;
$quotegrabs_file = "$home/pbot/quotegrabs" unless defined $quotegrabs_file;
$admins_file = "$home/pbot/admins" unless defined $admins_file;
$module_dir = "$home/pbot/modules" unless defined $module_dir;
$ircserver = "irc.freenode.net" unless defined $ircserver;
$botnick = "pbot2" unless defined $botnick;
$identify_password = "" unless defined $identify_password;
$export_factoids_timeout = -1 unless defined $export_factoids_timeout;
$export_factoids_time = gettimeofday + $export_factoids_timeout;
$export_quotegrabs_timeout = -1 unless defined $export_quotegrabs_timeout;
$export_quotegrabs_time = gettimeofday + $export_quotegrabs_timeout;
$max_msg_len = 460 unless defined $max_msg_len;
$MAX_FLOOD_MESSAGES = 4 unless defined $MAX_FLOOD_MESSAGES;
$MAX_NICK_MESSAGES = 8 unless defined $MAX_NICK_MESSAGES;
$commands{version} = {
enabled => 1,
owner => $botnick,
text => "/say pbot2 version $VERSION",
timestamp => 0,
ref_count => 0,
ref_user => "nobody" };
# TODO: wrap these in Setters/Getters
unshift @quotegrabs, ({
nick => $botnick,
text => "Who's a bot?",
channel => "#pbot2",
grabbed_by => "pragma_",
id => 1,
timestamp => 0 });
$admins{$botnick} = {
password => '*',
level => 50,
login => 1,
host => "localhost" };
my $self = {
# TODO: add conf variables here
};
$logger = new PBot::Logger(log_file => $log_file);
bless $self, $class;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
my $irc = new Net::IRC;
sub initialize {
my ($self, %conf) = @_;
my $log_file = delete $conf{log_file};
my $channels_file = delete $conf{channels_file};
my $admins_file = delete $conf{admins_file};
my $botnick = delete $conf{botnick};
my $identify_password = delete $conf{identify_password};
my $ircserver = delete $conf{ircserver};
my $max_msg_len = delete $conf{max_msg_len};
my $MAX_FLOOD_MESSAGES = delete $conf{MAX_FLOOD_MESSAGES};
my $MAX_NICK_MESSAGES = delete $conf{MAX_NICK_MESSAGES};
my $factoids_file = delete $conf{factoids_file};
my $export_factoids_timeout = delete $conf{export_factoids_timeout};
my $export_factoids_path = delete $conf{export_factoids_path};
my $export_factoids_site = delete $conf{export_factoids_site};
my $module_dir = delete $conf{module_dir};
my $quotegrabs_file = delete $conf{quotegrabs_file};
my $export_quotegrabs_timeout = delete $conf{export_quotegrabs_timeout};
my $export_quotegrabs_path = delete $conf{export_quotegrabs_path};
my $export_quotegrabs_site = delete $conf{export_quotegrabs_site};
$ircserver = "irc.freenode.net" unless defined $ircserver;
$botnick = "pbot2" unless defined $botnick;
$identify_password = "" unless defined $identify_password;
$max_msg_len = 460 unless defined $max_msg_len;
$MAX_FLOOD_MESSAGES = 4 unless defined $MAX_FLOOD_MESSAGES;
$MAX_NICK_MESSAGES = 8 unless defined $MAX_NICK_MESSAGES;
$self->{botnick} = $botnick;
$self->{identify_password} = $identify_password;
$self->{max_msg_len} = $max_msg_len;
$self->{MAX_FLOOD_MESSAGES} = $MAX_FLOOD_MESSAGES;
$self->{MAX_NICK_MESSAGES} = $MAX_NICK_MESSAGES;
$self->{FLOOD_CHAT} = 0;
my $logger = PBot::Logger->new(log_file => $log_file);
$self->{logger} = $logger;
$self->{admins} = PBot::BotAdmins->new(
pbot => $self,
filename => $admins_file,
);
$self->admins->load_admins();
$self->admins->add_admin('*', "$botnick!stdin\@localhost", 50, 'admin');
$self->admins->login('*', "$botnick!stdin\@localhost", "admin");
$self->{factoids} = PBot::Factoids->new(
pbot => $self,
filename => $factoids_file,
export_path => $export_factoids_path,
export_site => $export_factoids_site,
);
$self->factoids->add_factoid('text', '.*', $botnick, 'version', "/say pbot2 version $VERSION");
$self->factoids->load_factoids() if defined $factoids_file;
$self->module_dir($module_dir);
$self->{commands} = PBot::Commands->new(pbot => $self);
$self->{antiflood} = PBot::AntiFlood->new(pbot => $self);
$self->{ignorelist} = PBot::IgnoreList->new(pbot => $self);
$self->interpreter(PBot::Interpreter->new(pbot => $self));
$self->interpreter->register(sub { return $self->commands->interpreter(@_); });
$self->interpreter->register(sub { return $self->factoids->interpreter(@_); });
$self->{botadmincmds} = PBot::BotAdminCommands->new(pbot => $self);
$self->{factoidcmds} = PBot::FactoidCommands->new(pbot => $self);
$self->{ignorelistcmds} = PBot::IgnoreListCommands->new(pbot => $self);
$self->{irc} = Net::IRC->new();
$self->{ircserver} = $ircserver;
$self->{irchandlers} = PBot::IRCHandlers->new(pbot => $self);
$self->{channels} = PBot::Channels->new(pbot => $self, filename => $channels_file);
$self->channels->load_channels() if defined $channels_file;
$self->{chanops} = PBot::ChanOps->new(pbot => $self);
$self->{timer} = PBot::Timer->new(timeout => 10);
$self->timer->register(sub { $self->factoids->export_factoids }, $export_factoids_timeout) if defined $export_factoids_path;
# $self->timer->register(sub { $self->quotegrabs->export_quotegrabs }, $export_quotegrabs_timeout) if defined $export_quotegrabs_path;
$self->timer->start();
}
# TODO: add disconnect subroutine
sub connect {
my ($self, $server) = @_;
$server = $ircserver if not defined $server;
$server = $self->ircserver if not defined $server;
$logger->log("Connecting to $server ...\n");
$conn = $irc->newconn(
Nick => $botnick,
Username => 'pbot3', # FIXME: make this config
Ircname => 'http://www.iso-9899.info/wiki/Candide', # FIXME: make this config
if($self->{connected}) {
# TODO: disconnect, clean-up, etc
}
$self->logger->log("Connecting to $server ...\n");
$self->conn($self->irc->newconn(
Nick => $self->{botnick},
Username => $self->{username},
Ircname => $self->{ircname},
Server => $server,
Port => 6667) # FIXME: make this config
or die "$0: Can't connect to IRC server.\n";
Port => $self->{port}))
or Carp::croak "$0: Can't connect to IRC server.\n";
#set up handlers for the IRC engine
$conn->add_handler([ 251,252,253,254,302,255 ], \&PBot::IRCHandlers::on_init );
$conn->add_handler(376 , \&PBot::IRCHandlers::on_connect );
$conn->add_handler('disconnect' , \&PBot::IRCHandlers::on_disconnect );
$conn->add_handler('notice' , \&PBot::IRCHandlers::on_notice );
$conn->add_handler('caction' , \&PBot::IRCHandlers::on_action );
$conn->add_handler('public' , \&PBot::IRCHandlers::on_public );
$conn->add_handler('msg' , \&PBot::IRCHandlers::on_msg );
$conn->add_handler('mode' , \&PBot::IRCHandlers::on_mode );
$conn->add_handler('part' , \&PBot::IRCHandlers::on_departure );
$conn->add_handler('join' , \&PBot::IRCHandlers::on_join );
$conn->add_handler('quit' , \&PBot::IRCHandlers::on_departure );
$self->{connected} = 1;
#set up default handlers for the IRC engine
$self->conn->add_handler([ 251,252,253,254,302,255 ], sub { $self->irchandlers->on_init(@_) });
$self->conn->add_handler(376 , sub { $self->irchandlers->on_connect(@_) });
$self->conn->add_handler('disconnect' , sub { $self->irchandlers->on_disconnect(@_) });
$self->conn->add_handler('notice' , sub { $self->irchandlers->on_notice(@_) });
$self->conn->add_handler('caction' , sub { $self->irchandlers->on_action(@_) });
$self->conn->add_handler('public' , sub { $self->irchandlers->on_public(@_) });
$self->conn->add_handler('msg' , sub { $self->irchandlers->on_msg(@_) });
$self->conn->add_handler('mode' , sub { $self->irchandlers->on_mode(@_) });
$self->conn->add_handler('part' , sub { $self->irchandlers->on_departure(@_) });
$self->conn->add_handler('join' , sub { $self->irchandlers->on_join(@_) });
$self->conn->add_handler('quit' , sub { $self->irchandlers->on_departure(@_) });
}
#main loop
sub do_one_loop {
my $self = shift;
# process IRC events
$irc->do_one_loop();
$self->irc->do_one_loop();
# process STDIN events
check_stdin();
$self->check_stdin();
}
sub start {
my $self = shift;
if(not defined $self->{connected} or $self->{connected} == 0) {
$self->connect();
}
while(1) {
$self->do_one_loop();
}
}
sub check_stdin {
my $self = shift;
my $input = PBot::StdinReader::check_stdin();
return if not defined $input;
$logger->log("---------------------------------------------\n");
$logger->log("Read '$input' from STDIN\n");
$self->logger->log("---------------------------------------------\n");
$self->logger->log("Read '$input' from STDIN\n");
my ($from, $text);
@ -194,19 +231,108 @@ sub check_stdin {
$text = "!$input";
}
return PBot::Interpreter::process_line($from, $botnick, "stdin", "localhost", $text);
return $self->interpreter->process_line($from, $self->{botnick}, "stdin", "localhost", $text);
}
sub load_channels {
return PBot::ChannelStuff::load_channels();
sub irc {
my $self = shift;
return $self->{irc};
}
sub load_quotegrabs {
return PBot::Quotegrabs::load_quotegrabs();
sub logger {
my $self = shift;
if(@_) { $self->{logger} = shift; }
return $self->{logger};
}
sub load_commands {
return PBot::FactoidStuff::load_commands();
sub channels {
my $self = shift;
if(@_) { $self->{channels} = shift; }
return $self->{channels};
}
sub factoids {
my $self = shift;
if(@_) { $self->{factoids} = shift; }
return $self->{factoids};
}
sub timer {
my $self = shift;
if(@_) { $self->{timer} = shift; }
return $self->{timer};
}
sub conn {
my $self = shift;
if(@_) { $self->{conn} = shift; }
return $self->{conn};
}
sub irchandlers {
my $self = shift;
if(@_) { $self->{irchandlers} = shift; }
return $self->{irchandlers};
}
sub interpreter {
my $self = shift;
if(@_) { $self->{interpreter} = shift; }
return $self->{interpreter};
}
sub admins {
my $self = shift;
if(@_) { $self->{admins} = shift; }
return $self->{admins};
}
sub commands {
my $self = shift;
if(@_) { $self->{commands} = shift; }
return $self->{commands};
}
sub botnick {
my $self = shift;
if(@_) { $self->{botnick} = shift; }
return $self->{botnick};
}
sub identify_password {
my $self = shift;
if(@_) { $self->{identify_password} = shift; }
return $self->{identify_password};
}
sub max_msg_len {
my $self = shift;
if(@_) { $self->{max_msg_len} = shift; }
return $self->{max_msg_len};
}
sub module_dir {
my $self = shift;
if(@_) { $self->{module_dir} = shift; }
return $self->{module_dir};
}
sub ignorelist {
my $self = shift;
if(@_) { $self->{ignorelist} = shift; }
return $self->{ignorelist};
}
sub antiflood {
my $self = shift;
if(@_) { $self->{antiflood} = shift; }
return $self->{antiflood};
}
sub ircserver {
my $self = shift;
if(@_) { $self->{ircserver} = shift; }
return $self->{ircserver};
}
1;

94
PBot/Registerable.pm Normal file
View File

@ -0,0 +1,94 @@
# File: Registerable.pm
# Author: pragma_
#
# Purpose: Provides functionality to register and execute one or more subroutines.
package PBot::Registerable;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = '1.0.0';
}
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Registerable should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my $self = shift;
$self->{handlers} = [];
}
sub execute_all {
my $self = shift;
if($#{ $self->{handlers} } > -1) {
foreach my $func (@{ $self->{handlers} }) {
my $result = &{ $func->{subref} }(@_);
return $result if defined $result;
}
}
return undef;
}
sub execute {
my $self = shift;
my $ref = shift;
if(not defined $ref) {
Carp::croak("Missing reference parameter to Registerable::execute");
}
foreach my $func (@{ $self->{handlers} }) {
if($ref == $func || $ref == $func->{subref}) {
return &{ $func->{subref} }(@_);
}
}
return undef;
}
sub register {
my $self = shift;
my $subref;
if(@_) {
$subref = shift;
} else {
Carp::croak("Must pass subroutine reference to register()");
}
# TODO: Check if subref already exists in handlers?
my $ref = { subref => $subref };
push @{ $self->{handlers} }, $ref;
return $ref;
}
sub unregister {
my $self = shift;
my $ref;
if(@_) {
$ref = shift;
} else {
Carp::croak("Must pass subroutine reference to unregister()");
}
@{ $self->{handlers} } = grep { $_ != $ref && $_->{subref} != $ref } @{ $self->{handlers} };
}
1;

3
PBot/StdinReader.pm
View File

@ -25,7 +25,8 @@ sub check_stdin {
return if not $foreground;
if ($stdin->can_read(.5)) {
chomp(my $input = <STDIN>);
sysread(STDIN, my $input, 1024);
chomp $input;
return $input;
}
}

207
PBot/Timer.pm Normal file
View File

@ -0,0 +1,207 @@
# File: Timer.pm
# Author: pragma_
#
# Purpose: Provides functionality to register and execute one or more subroutines every X seconds.
#
# Caveats: Uses ALARM signal and all its issues.
package PBot::Timer;
use warnings;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = '1.0.0';
}
use Carp ();
our $min_timeout = 10;
our $max_seconds = 1000000;
our $seconds = 0;
our @timer_funcs;
$SIG{ALRM} = sub {
$seconds += $min_timeout;
alarm $min_timeout;
# print "ALARM! $seconds $min_timeout\n";
# call timer func subroutines
foreach my $func (@timer_funcs) { &$func; }
# prevent $seconds over-flow
$seconds -= $max_seconds if $seconds > $max_seconds;
};
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to Timer should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $timeout = delete $conf{timeout};
$timeout = 10 unless defined $timeout;
my $name = delete $conf{name};
$name = "Unnamed $timeout Second Timer" unless defined $name;
my $self = {
handlers => [],
name => $name,
timeout => $timeout,
enabled => 0,
};
bless $self, $class;
$min_timeout = $timeout if $timeout < $min_timeout;
# alarm signal handler (poor-man's timer)
$self->{timer_func} = sub { on_tick_handler($self) };
return $self;
}
sub start {
my $self = shift;
# print "Starting Timer $self->{name} $self->{timeout} $self->{enabled}\n";
$self->{enabled} = 1;
push @timer_funcs, $self->{timer_func};
alarm $min_timeout;
}
sub stop {
my $self = shift;
# print "Stopping timer $self->{name}\n";
$self->{enabled} = 0;
@timer_funcs = grep { $_ != $self->{timer_func} } @timer_funcs;
}
sub on_tick_handler {
my $self = shift;
my $elapsed = 0;
# print "-----\n";
# print "on tick handler for $self->{name}\n";
if($self->{enabled}) {
if($#{ $self->{handlers} } > -1) {
# call handlers supplied via register() if timeout for each has elapsed
foreach my $func (@{ $self->{handlers} }) {
if(defined $func->{last}) {
$func->{last} -= $max_seconds if $seconds < $func->{last}; # handle wrap-around of $seconds
if($seconds - $func->{last} >= $func->{timeout}) {
$func->{last} = $seconds;
$elapsed = 1;
}
} else {
$func->{last} = $seconds;
$elapsed = 1;
}
if($elapsed) {
&{ $func->{subref} }($self);
$elapsed = 0;
}
}
} else {
# call default overridable handler if timeout has elapsed
if(defined $self->{last}) {
# print "$self->{name} last = $self->{last}, seconds: $seconds, timeout: " . $self->timeout . " " . ($seconds - $self->{last}) . "\n";
$self->{last} -= $max_seconds if $seconds < $self->{last}; # handle wrap-around
if($seconds - $self->{last} >= $self->timeout) {
$elapsed = 1;
$self->{last} = $seconds;
}
} else {
# print "New addition for $self->{name}\n";
$elapsed = 1;
$self->{last} = $seconds;
}
if($elapsed) {
$self->on_tick();
$elapsed = 0;
}
}
}
# print "-----\n";
}
# overridable method, executed whenever timeout is triggered
sub on_tick {
my $self = shift;
print "Tick! $self->{name} $self->{timeout} $self->{last} $seconds\n";
}
sub register {
my $self = shift;
my ($ref, $timeout);
if(@_) {
($ref, $timeout) = @_;
} else {
Carp::croak("Must pass subroutine reference to register()");
}
# TODO: Check if subref already exists in handlers?
$timeout = 300 if not defined $timeout; # set default value of 5 minutes if not defined
my $h = { subref => $ref, timeout => $timeout };
push @{ $self->{handlers} }, $h;
# print "-- Registering timer $ref at $timeout seconds\n";
if($timeout < $min_timeout) {
$min_timeout = $timeout;
}
if($self->{enabled}) {
alarm $min_timeout;
}
}
sub unregister {
my $self = shift;
my $ref;
if(@_) {
$ref = shift;
} else {
Carp::croak("Must pass subroutine reference to unregister()");
}
# print "-- Removing timer $ref\n";
@{ $self->{handlers} } = grep { $_->{subref} != $ref } @{ $self->{handlers} };
}
sub max_seconds {
if(@_) { $max_seconds = shift; }
return $max_seconds;
}
sub timeout {
my $self = shift;
if(@_) { $self->{timeout} = shift; }
return $self->{timeout};
}
sub name {
my $self = shift;
if(@_) { $self->{name} = shift; }
return $self->{name};
}
1;

170
PBot/TimerStuff.pm
View File

@ -1,170 +0,0 @@
# File: NewModule.pm
# Authoer: pragma_
#
# Purpose: New module skeleton
package PBot::TimerStuff;
use warnings;
use strict;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = $PBot::PBot::VERSION;
@ISA = qw(Exporter);
@EXPORT_OK = qw(%quieted_nicks $logger $conn %ignore_list %is_opped %unban_timeout $export_quotegrabs_path
$export_quotegrabs_time $export_quotegrabs_timeout $export_factoids_path $export_factoids_time
$export_factoids_timeout %flood_watch @op_commands);
}
use vars @EXPORT_OK;
use Time::HiRes qw(gettimeofday);
*logger = \$PBot::PBot::logger;
*conn = \$PBot::PBot::conn;
*ignore_list = \%PBot::IgnoreList::ignore_list;
*is_opped = \%PBot::OperatorStuff::is_opped;
*op_commands = \@PBot::OperatorStuff::op_commands;
*quieted_nicks = \%PBot::OperatorStuff::quieted_nicks;
*flood_watch = \%PBot::AntiFlood::flood_watch;
*unban_timeout = \%PBot::OperatorStuff::unban_timeout;
*export_quotegrabs_path = \$PBot::PBot::export_quotegrabs_path;
*export_quotegrabs_timeout = \$PBot::PBot::export_quotegrabs_timeout;
*export_quotegrabs_time = \$PBot::PBot::export_quotegrabs_time;
*export_factoids_path = \$PBot::PBot::export_factoids_path;
*export_factoids_timeout = \$PBot::PBot::export_factoids_timeout;
*export_factoids_time = \$PBot::PBot::export_factoids_time;
# alarm signal handler (poor-man's timer)
$SIG{ALRM} = \&sig_alarm_handler;
#start alarm timeout
alarm 10;
sub sig_alarm_handler {
# check timeouts
# TODO: Make this module a class with registerable handlers/call-backs
check_quieted_timeouts();
check_ignore_timeouts();
check_opped_timeout();
check_unban_timeouts();
check_export_timeout();
check_message_history_timeout();
alarm 10;
}
# TODO: Move these to their respective modules, and add handler support
sub check_quieted_timeouts {
my $now = gettimeofday();
foreach my $nick (keys %quieted_nicks) {
if($quieted_nicks{$nick}{time} < $now) {
$logger->log("Unquieting $nick\n");
PBot::OperatorStuff::unquiet_nick($nick, $quieted_nicks{$nick}{channel});
delete $quieted_nicks{$nick};
$conn->privmsg($nick, "You may speak again.");
} else {
#my $timediff = $quieted_nicks{$nick}{time} - $now;
#$logger->log "quiet: $nick has $timediff seconds remaining\n"
}
}
}
sub check_ignore_timeouts {
my $now = gettimeofday();
foreach my $hostmask (keys %ignore_list) {
foreach my $channel (keys %{ $ignore_list{$hostmask} }) {
next if($ignore_list{$hostmask}{$channel} == -1); #permanent ignore
if($ignore_list{$hostmask}{$channel} < $now) {
PBot::IgnoreList::unignore_user("", "floodcontrol", "", "$hostmask $channel");
if($hostmask eq ".*") {
$conn->me($channel, "awakens.");
}
} else {
#my $timediff = $ignore_list{$host}{$channel} - $now;
#$logger->log "ignore: $host has $timediff seconds remaining\n"
}
}
}
}
sub check_opped_timeout {
my $now = gettimeofday();
foreach my $channel (keys %is_opped) {
if($is_opped{$channel}{timeout} < $now) {
PBot::OperatorStuff::lose_ops($channel);
} else {
# my $timediff = $is_opped{$channel}{timeout} - $now;
# $logger->log("deop $channel in $timediff seconds\n");
}
}
}
sub check_unban_timeouts {
my $now = gettimeofday();
foreach my $ban (keys %unban_timeout) {
if($unban_timeout{$ban}{timeout} < $now) {
unshift @op_commands, "mode $unban_timeout{$ban}{channel} -b $ban";
PBot::OperatorStuff::gain_ops($unban_timeout{$ban}{channel});
delete $unban_timeout{$ban};
} else {
#my $timediff = $unban_timeout{$ban}{timeout} - $now;
#$logger->log("$unban_timeout{$ban}{channel}: unban $ban in $timediff seconds\n");
}
}
}
sub check_export_timeout {
my $now = gettimeofday();
if($now > $export_quotegrabs_time && defined $export_quotegrabs_path) {
PBot::Quotegrabs::export_quotegrabs();
$export_quotegrabs_time = $now + $export_quotegrabs_timeout;
}
if($now > $export_factoids_time && defined $export_factoids_path) {
PBot::FactoidStuff::export_factoids();
$export_factoids_time = $now + $export_factoids_timeout;
}
}
BEGIN {
my $last_run = gettimeofday();
sub check_message_history_timeout {
my $now = gettimeofday();
if($now - $last_run < 60 * 60) {
return;
} else {
$logger->log("One hour has elapsed -- running check_message_history_timeout\n");
}
$last_run = $now;
foreach my $nick (keys %flood_watch) {
foreach my $channel (keys %{ $flood_watch{$nick} })
{
#$logger->log("Checking [$nick][$channel]\n");
my $length = $#{ $flood_watch{$nick}{$channel}{messages} } + 1;
my %last = %{ @{ $flood_watch{$nick}{$channel}{messages} }[$length - 1] };
if($now - $last{timestamp} >= 60 * 60 * 24) {
$logger->log("$nick in $channel hasn't spoken in 24 hours, removing message history.\n");
delete $flood_watch{$nick}{$channel};
}
}
}
}
}
1;

1
admins Normal file
View File

@ -0,0 +1 @@
* *!pragma@unaffiliated/pragma/x-109842 50 pop

4
channels
View File

@ -1,3 +1,3 @@
##c 1 1 0
##c 0 1 0
#pbot2 1 1 0
##philosophy 1 0 0
##philosophy 0 0 0

2
cs
View File

@ -1,5 +1,5 @@
#!/bin/sh
rm stderr_log log
rm stderr_log log 2>/dev/null
./fpb
cat stderr_log

12
commands → factoids
View File

@ -445,7 +445,7 @@ common text 1 pragma_ 1230993541 2 cousteau http://www.myconfinedspace.com/wp-co
comparch text 1 pragma_ 1180158061 1 pragma_ http://dept-info.labri.fr/~strandh/Teaching/AMP/Common/Strandh-Tutorial/Dir.html
compilerline text 1 PoppaVic 1266709397 2 PoppaVic Order Matters: CC <overall options> [-std=whatever] <debugging> <optimizing> <warnings> [-pedantic] <Other Include Paths> <Other Lib Paths> <Magic Defines> <Magic Undefines> [-f<language/platform options] [-m<machine options>] [-o outfile] files..... (this is all documented, and files can be .c or .o, .a or .so, or -l<to be linked> commands.) <paraphrased from man gcc>
compliance text 1 n00p 1263936847 0 nobody !portability
compliment module 1 pragma_ 1255395343 37 notk0 compliment
compliment module 1 pragma_ 1255395343 38 pragma__ compliment
const text 1 prec 1107648578 19 kuala http://publications.gbdirect.co.uk/c_book/chapter8/const_and_volatile.html - see section 8.4.1, http://c-faq.com/ansi/constmismatch.html
continue text 1 Major-Willard 1104888657 4 pragma_ the statement used recommence the currently executing block
controlstack text 1 PoppaVic 1174907617 2 lemonade`_ http://www.answers.com/topic/call-stack
@ -561,7 +561,7 @@ gettimeofday text 1 Major-Willard 1104639290 0 nobody a function that returns th
gigo text 1 prec 1177948351 5 zu22 Garbage In, Garbage Out -- http://c-faq.com/malloc/malloc1.html
gnumake text 1 pragma_ 1194222910 1 pragma_ http://www.gnu.org/software/make/manual/make.pdf
godprogrammer text 1 pragma_ 1260214264 9 lemonade` /say It's not unreasonable that if computer programmers developed an autonomous self-learning/self-correcting AI world and allowed it to run for several billion iterations; then came back to it, that they may not be able to alter it without destroying it. If such a programmer were to have orginally created debug routines and backdoors, such code would ultimately point to obsolete code regions.
google module 1 pragma_ 1105953714 572 PoppaVic google.pl
google module 1 pragma_ 1105953714 573 pragma_ google.pl
gotchas text 1 kate` 1244833982 102 Dianora /say http://www.iso-9899.info/wiki/C_gotchas
goto text 1 Baughn 1186325626 6 cousteau http://imgs.xkcd.com/comics/goto.png
greenspun text 1 mauke 1108933892 3 leth /say Greenspun's Tenth Rule of Programming: "Any sufficiently complicated C or Fortran program contains an ad-hoc, informally-specified bug-ridden slow implementation of half of Common Lisp."
@ -582,7 +582,7 @@ hello text 1 pragma_ 1179679787 54 pragma_ /call hi
helloworld text 1 pragma_ 1237684920 0 nobody http://www.lisha.ufsc.br/~guto/teaching/os/exercise/hello.html
help text 1 NeverDream 1109792986 398 Chris /say To learn all about me, see http://www.iso-9899.info/wiki/Candide
herring text 1 Baughn 1173805492 1 rhc a vicious species, loyal only to Baughn. Attempts to wrest control of the Herring Hordes can result in consequences similar to http://fukung.net/v/2833/15cod.jpg .
hi text 1 pragma_ 1109044278 709 pragma_ /say $hi_phrases, $nick
hi text 1 pragma_ 1109044278 733 pragma_ /say $hi_phrases, $nick
hi_phrases text 1 pragma_ 1109044257 1 dav7 "Well, hello there" "Hi there" "Hey, whats up" Hola Hi Hello "Que pasa"
hint text 1 pragma_ 1205575974 1 pragma_ http://www.yesfunny.com/Sports/sports8.jpeg -- in other words, are you sure C is for you?
hit text 1 pragma_ 1258701405 3 pragma_ /call slap
@ -605,7 +605,7 @@ idiot text 1 pragma_ 1194139898 6 mordy_ moron knucklehead dolt half-wit retard
if text 1 Major-Willard 1105258377 10 M1TE5H the keyword that tests a bracketed expression and if true, executes the following statement or block; if the expression evaluates to false an optional ''else'' clause is executed
ignore text 1 snhmib 1204687457 0 nobody nubsauce
implementation text 1 pragma_ 1106459085 1 pragma_ a particular set of software, running in a particular translation environment under particular control options, that performs translation of programs for, and supports execution of functions in, a particular execution environment (ISO/IEC 9899:1999 3.12)
insult module 1 pragma_ 1236819209 349 pragma_ insult.pl
insult module 1 pragma_ 1236819209 353 pragma_ insult.pl
int text 1 infobahn 1104595147 17 n00p a signed integer data type, at least 16 bits wide, which must be able to represent (at least) all the numbers in the range -32767 to +32767. Its lowest value, INT_MIN, and highest value, INT_MAX, are defined in <limits.h>
integer text 1 prec 1189048945 2 cousteau http://wikipedia.org/wiki/Integer
intelmanuals text 1 ColonelJ 1260039944 0 nobody http://developer.intel.com/products/processor/manuals/index.htm
@ -649,7 +649,7 @@ linkageandstorage text 1 kate` 1221600612 3 Wulf_ /say http://www.iso-9899.info/
literal text 1 pragma_ 1179678945 7 kuala /call show
little text 1 Pip 1250423849 0 nobody horny
livelife text 1 PARLIAMENT 1264393732 2 PARLIAMENT /say $sfq
lol text 1 syntropy_ 1254011046 12 tuxedomask /say hello
lol text 1 syntropy_ 1254011046 13 qwertypus /say hello
long text 1 infobahn 1104595499 7 bros a signed integer data type, at least 32 bits wide, which must be able to represent (at least) all the integers in the range -2147483647 to +2147483647. Its lowest value, LONG_MIN, and highest value, LONG_MAX, are defined in <limits.h>
look\sup\s([^\s]+) regex 1 pragma_ 1194261643 0 nobody man $1
lsb text 1 PoppaVic 1182000690 4 lemonade` http://refspecs.freestandards.org/LSB_2.1.0/LSB-generic/LSB-generic/book1.html
@ -803,7 +803,7 @@ rule3 text 1 PoppaVic 1106163837 3 Koper "Finally, make it run fast or small (pi
rules text 1 gunninK 1264177779 2 gunninK $nick rules
rvalue text 1 Wulf_ 1251745571 1 Wulf_ the "value of an expression"
s&w text 1 ment 1251220163 1 ment when k&r fails, try http://www.smith-wesson.com/
say text 1 pragma_ 1251663502 299 candide /say $args
say text 1 pragma_ 1251663502 306 candide /say $args
scanf text 1 Major-Willard 1106970012 271 Dianora a function that's stupid - "It's nearly impossible to do decent error recovery with scanf; usually it's far easier to read entire lines (with fgets or the like), then interpret them, either using sscanf or some other techniques." - See http://www.eskimo.com/~scs/C-faq/q12.20.html
scanf_is_stupid text 1 n00p 1264982172 1 pragma_ /say It looks like the !scanf factoid was unsuccessful at convincing you not to use scanf(). scanf() isn't really that stupid, providing you know how to use it correctly. Chris Torek explains some problems with the way scanf() is commonly used and provides methods of solving those problems here: http://bytes.com/topic/c/answers/215517-warning-against-scanf#post840862
schildt text 1 twkm 1105514020 13 pragma_ please avoid herbert schildt's books, see http://www.iso-9899.info/wiki/Main_Page#Stuff_that_should_be_avoided

2
modules/compliment
View File

@ -1,2 +1,2 @@
#!/bin/sh
/home/msmud/pbot2/modules/lookupbot.pl compliment $*
~/pbot/modules/lookupbot.pl compliment $*

14
modules/define.pl
View File

@ -22,24 +22,26 @@ if($phrase =~ m/([0-9]+)%20(.*)/)
$phrase = $2;
}
$text = get("http://dictionary.reference.com/search?q=$phrase");
$text = get("http://dictionary.reference.com/browse/$phrase");
$phrase =~ s/\%20/ /g;
if($text =~ m/because there was not a match on/i)
if($text =~ m/no dictionary results/i)
{
print "No entry found for '$phrase'. ";
if($text =~ m/Dictionary suggestions:/g)
if($text =~ m/Did you mean <a class.*?>(.*?)<\/a>/g)
{
print "Suggestions: ";
print "Did you mean '$1'? Alternate suggestions: ";
$i = 90;
while($text =~ m/<a href="\/search\?r=2&amp;q=.*?>(.*?)<\/a>/g && $i > 0)
$comma = "";
while($text =~ m/<div id="spellSuggestWrapper"><li .*?><a href=.*?>(.*?)<\/a>/g && $i > 0)
{
print "$1, ";
print "$comma$1";
$i--;
$comma = ", ";
}
}

24
modules/get_title.pl
View File

@ -9,20 +9,20 @@ my ($text);
if ($#ARGV <= 0)
{
print "Usage: !title nick URL\n";
die;
exit;
}
my $nick = shift(@ARGV);
$arguments = join("%20", @ARGV);
die if($arguments =~ m/imagebin/i);
die if($arguments =~ m/\/wiki\//i);
die if($arguments =~ m/wikipedia.org/i);
die if($arguments =~ m/everfall.com/i);
die if($arguments =~ m/pastie.org/i);
die if($arguments =~ m/codepad/i);
die if($arguments =~ m/paste.*\.(?:com|org|net|ca|uk)/i);
die if($arguments =~ m/pasting.*\.(?:com|org|net|ca|uk)/i);
exit if($arguments =~ m/imagebin/i);
exit if($arguments =~ m/\/wiki\//i);
exit if($arguments =~ m/wikipedia.org/i);
exit if($arguments =~ m/everfall.com/i);
exit if($arguments =~ m/pastie/i);
exit if($arguments =~ m/codepad/i);
exit if($arguments =~ m/paste.*\.(?:com|org|net|ca|uk)/i);
exit if($arguments =~ m/pasting.*\.(?:com|org|net|ca|uk)/i);
my $ua = LWP::UserAgent->new;
$ua->agent("Mozilla/5.0");
@ -33,7 +33,7 @@ my $response = $ua->get("$arguments");
if (not $response->is_success)
{
#print "Couldn't get link.\n";
die;
die "Couldn't get link: $arguments";
}
$text = $response->content;
@ -43,7 +43,7 @@ if($text =~ m/<title>(.*?)<\/title>/msi)
$t = $1;
} else {
#print "No title for link.\n";
die;
exit;
}
my $quote = chr(226) . chr(128) . chr(156);
@ -59,6 +59,8 @@ $t =~ s/$quote/"/g;
$t =~ s/$quote2/"/g;
$t =~ s/$dash/-/g;
$t =~ s/&quot;/"/g;
$t =~ s/&#8220;/"/g;
$t =~ s/&#8221;/"/g;
$t =~ s/&amp;/&/g;
$t =~ s/&nsb;/ /g;
$t =~ s/&#39;/'/g;

2
modules/horoscope
View File

@ -1,2 +1,2 @@
#!/bin/sh
/home/msmud/pbot2/modules/lookupbot.pl horoscope $*
~/pbot/modules/lookupbot.pl horoscope $*

2
modules/random_quote.pl
View File

@ -53,7 +53,7 @@ while(1) {
$author =~ s/\++$//;
# print "http://www.quotationspage.com/search.php3?Search=$arguments&startsearch=Search&Author=$author&C=mgm&C=motivate&C=classic&C=coles&C=poorc&C=lindsly&C=net&C=devils&C=contrib&page=$page\n";
$response = $ua->get("http://www.quotationspage.com/search.php3?Search=$arguments&startsearch=Search&Author=$author&C=mgm&C=motivate&C=classic&C=coles&C=poorc&C=lindsly&C=net&C=devils&C=contrib&page=$page");
$response = $ua->get("http://www.quotationspage.com/search.php3?Search=$arguments&startsearch=Search&Author=$author&C=mgm&C=motivate&C=classic&C=coles&C=poorc&C=lindsly&C=net&C=contrib&page=$page");
}
if (not $response->is_success)

2
modules/urban
View File

@ -1,2 +1,2 @@
#!/bin/sh
/home/msmud/pbot2/modules/lookupbot.pl urban $*
~/pbot/modules/lookupbot.pl urban $*

33
pbot.pl
View File

@ -8,10 +8,10 @@
# Version History:
########################
my $VERSION = "0.5.0-beta";
my $VERSION = "1.0.0";
########################
# 0.5.0-beta (03/14/10): Initial version using PBot::PBot module
# 1.0.0 (03/14/10): Initial version using PBot::PBot module
use strict;
use warnings;
@ -22,22 +22,27 @@ my $home = $ENV{HOME};
my %config = ( log_file => "$home/pbot/log",
channels_file => "$home/pbot/channels",
commands_file => "$home/pbot/commands",
quotegrabs_file => "$home/pbot/quotegrabs",
admins_file => "$home/pbot/admins",
channels_file => "$home/pbot/channels",
factoids_file => "$home/pbot/factoids",
export_factoids_path => "$home/pbot/factoids.html",
export_factoids_site => 'http://blackshell.com/~msmud/pbot2/factoids.html',
export_factoids_timeout => 300, # 5 minutes
module_dir => "$home/pbot/modules",
quotegrabs_file => "$home/pbot/quotegrabs",
export_quotegrabs_path => "$home/pbot/quotegrabs.html",
export_quotegrabs_site => 'http://blackshell.com/~msmud/pbot2/quotegrabs.html',
export_quotegrabs_timeout => 300, # 5 minutes
ircserver => 'irc.freenode.net',
botnick => 'pbot3'
botnick => 'pragma__',
identify_password => 'hopelus',
);
my $pbot = PBot::PBot->new(%config);
$pbot->load_channels();
$pbot->load_quotegrabs();
$pbot->load_commands();
$pbot->start();
$pbot->connect();
while(1) {
$pbot->do_one_loop();
}
# not reached