GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 20:09:43 +01:00
Code Issues Projects Releases Wiki Activity

Update core to use subroutine signatures

Browse Source
This commit is contained in:
Pragmatic Software 2023-04-13 21:04:12 -07:00
parent c6db4b1e6b
commit 7ddb32ea16
89 changed files with 645 additions and 1672 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lib/PBot/Core.pm
View File

@ -71,16 +71,13 @@ BEGIN {
@ARGV = map { decode('UTF-8', $_, 1) } @ARGV; @ARGV = map { decode('UTF-8', $_, 1) } @ARGV;
} }
sub new { sub new($class, %args) {
my ($class, %args) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
$self->initialize(%args); $self->initialize(%args);
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{startup_timestamp} = time; $self->{startup_timestamp} = time;
# process command-line arguments for path and registry overrides # process command-line arguments for path and registry overrides
@ -225,8 +222,7 @@ sub initialize {
$self->{logger}->log("PBot::Core initialized.\n"); $self->{logger}->log("PBot::Core initialized.\n");
} }
sub random_nick { sub random_nick($self, $length) {
my ($self, $length) = @_;
$length //= 9; $length //= 9;
my @chars = ("A" .. "Z", "a" .. "z", "0" .. "9"); my @chars = ("A" .. "Z", "a" .. "z", "0" .. "9");
my $nick = $chars[rand @chars - 10]; # nicks cannot start with a digit my $nick = $chars[rand @chars - 10]; # nicks cannot start with a digit
@ -235,9 +231,7 @@ sub random_nick {
} }
# TODO: add disconnect subroutine and connect/disconnect/reconnect commands # TODO: add disconnect subroutine and connect/disconnect/reconnect commands
sub connect { sub connect($self) {
my ($self) = @_;
return if $ENV{PBOT_LOCAL}; return if $ENV{PBOT_LOCAL};
my $server = $self->{registry}->get_value('irc', 'server'); my $server = $self->{registry}->get_value('irc', 'server');
@ -301,9 +295,7 @@ sub connect {
$self->{irchandlers}->add_handlers; $self->{irchandlers}->add_handlers;
} }
sub register_signal_handlers { sub register_signal_handlers($self) {
my ($self) = @_;
$SIG{INT} = sub { $SIG{INT} = sub {
my $msg = "SIGINT received, exiting immediately.\n"; my $msg = "SIGINT received, exiting immediately.\n";
if (exists $self->{logger}) { if (exists $self->{logger}) {
@ -317,8 +309,7 @@ sub register_signal_handlers {
} }
# called when PBot terminates # called when PBot terminates
sub atexit { sub atexit($self) {
my ($self) = @_;
$self->{atexit}->execute_all; $self->{atexit}->execute_all;
if (exists $self->{logger}) { if (exists $self->{logger}) {
$self->{logger}->log("Good-bye.\n"); $self->{logger}->log("Good-bye.\n");
@ -328,8 +319,7 @@ sub atexit {
} }
# convenient function to exit PBot # convenient function to exit PBot
sub exit { sub exit($self, $exitval) {
my ($self, $exitval) = @_;
$exitval //= EXIT_SUCCESS; $exitval //= EXIT_SUCCESS;
my $msg = "Exiting immediately.\n"; my $msg = "Exiting immediately.\n";
@ -344,9 +334,7 @@ sub exit {
} }
# main loop # main loop
sub do_one_loop { sub do_one_loop($self) {
my ($self) = @_;
# do an irc engine loop (select, eventqueues, etc) # do an irc engine loop (select, eventqueues, etc)
$self->{irc}->do_one_loop; $self->{irc}->do_one_loop;
@ -359,9 +347,7 @@ sub do_one_loop {
} }
# main entry point # main entry point
sub start { sub start($self) {
my ($self) = @_;
$self->connect; $self->connect;
while (1) { while (1) {

42
lib/PBot/Core/AntiFlood.pm
View File

@ -21,9 +21,7 @@ use Time::Duration;
use POSIX qw/strftime/; use POSIX qw/strftime/;
use Text::CSV; use Text::CSV;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# flags for 'validated' field # flags for 'validated' field
use constant { use constant {
NICKSERV_VALIDATED => (1 << 0), NICKSERV_VALIDATED => (1 << 0),
@ -64,9 +62,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.account', sub { $self->on_accountnotify(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.account', sub { $self->on_accountnotify(@_) });
} }
sub update_join_watch { sub update_join_watch($self, $account, $channel, $text, $mode) {
my ($self, $account, $channel, $text, $mode) = @_;
return if $channel =~ /[@!]/; # ignore QUIT messages from nick!user@host channels return if $channel =~ /[@!]/; # ignore QUIT messages from nick!user@host channels
my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $channel, 'join_watch'); my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $channel, 'join_watch');
@ -103,9 +99,7 @@ sub update_join_watch {
# TODO: break this gigantic function up into simple plugins # TODO: break this gigantic function up into simple plugins
# e.g. PBot::Plugin::AntiAbuse::ChatFlood, ::JoinFlood, ::EnterAbuse, etc. # e.g. PBot::Plugin::AntiAbuse::ChatFlood, ::JoinFlood, ::EnterAbuse, etc.
sub check_flood { sub check_flood($self, $channel, $nick, $user, $host, $text, $max_messages, $max_time, $mode, $context = undef) {
my ($self, $channel, $nick, $user, $host, $text, $max_messages, $max_time, $mode, $context) = @_;
$channel = lc $channel; $channel = lc $channel;
my $mask = "$nick!$user\@$host"; my $mask = "$nick!$user\@$host";
@ -569,8 +563,7 @@ sub check_flood {
$self->{channels}->{$channel}->{last_spoken_nick} = $nick if $mode == MSG_CHAT; $self->{channels}->{$channel}->{last_spoken_nick} = $nick if $mode == MSG_CHAT;
} }
sub address_to_mask { sub address_to_mask($self, $address) {
my ($self, $address) = @_;
my $banmask; my $banmask;
if ($address =~ m/^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/) { if ($address =~ m/^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/) {
@ -595,9 +588,8 @@ sub address_to_mask {
return $banmask; return $banmask;
} }
sub devalidate_accounts { # remove validation on accounts in $channel that match a ban/quiet $mask
# remove validation on accounts in $channel that match a ban/quiet $mask sub devalidate_accounts($self, $mask, $channel) {
my ($self, $mask, $channel) = @_;
my @message_accounts; my @message_accounts;
#$self->{pbot}->{logger}->log("Devalidating accounts for $mask in $channel\n"); #$self->{pbot}->{logger}->log("Devalidating accounts for $mask in $channel\n");
@ -620,8 +612,7 @@ sub devalidate_accounts {
} }
} }
sub check_bans { sub check_bans($self, $message_account, $mask, $channel, $dry_run = 0) {
my ($self, $message_account, $mask, $channel, $dry_run) = @_;
$channel = lc $channel; $channel = lc $channel;
return if not $self->{pbot}->{chanops}->can_gain_ops($channel); return if not $self->{pbot}->{chanops}->can_gain_ops($channel);
@ -845,8 +836,7 @@ sub check_bans {
} }
} }
sub on_endofwhois { sub on_endofwhois($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $nick = $event->{args}[1]; my $nick = $event->{args}[1];
delete $self->{whois_pending}->{$nick}; delete $self->{whois_pending}->{$nick};
@ -869,8 +859,7 @@ sub on_endofwhois {
return 0; return 0;
} }
sub on_whoisuser { sub on_whoisuser($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $nick = $event->{args}[1]; my $nick = $event->{args}[1];
my $gecos = lc $event->{args}[5]; my $gecos = lc $event->{args}[5];
@ -881,8 +870,7 @@ sub on_whoisuser {
$self->{pbot}->{messagehistory}->{database}->update_gecos($id, $gecos, scalar gettimeofday); $self->{pbot}->{messagehistory}->{database}->update_gecos($id, $gecos, scalar gettimeofday);
} }
sub on_whoisaccount { sub on_whoisaccount($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $nick = $event->{args}[1]; my $nick = $event->{args}[1];
my $account = lc $event->{args}[2]; my $account = lc $event->{args}[2];
@ -901,9 +889,7 @@ sub on_whoisaccount {
return 0; return 0;
} }
sub on_accountnotify { sub on_accountnotify($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $mask = $event->{from}; my $mask = $event->{from};
my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/; my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/;
my $account = $event->{args}[0]; my $account = $event->{args}[0];
@ -933,11 +919,7 @@ sub on_accountnotify {
return 0; return 0;
} }
sub adjust_offenses { sub adjust_offenses($self) {
my $self = shift;
#$self->{pbot}->{logger}->log("Adjusting offenses . . .\n");
# decrease offenses counter if 24 hours have elapsed since latest offense # decrease offenses counter if 24 hours have elapsed since latest offense
my $channel_datas = $self->{pbot}->{messagehistory}->{database}->get_channel_datas_where_last_offense_older_than(gettimeofday - 60 * 60 * 24); my $channel_datas = $self->{pbot}->{messagehistory}->{database}->get_channel_datas_where_last_offense_older_than(gettimeofday - 60 * 60 * 24);
foreach my $channel_data (@$channel_datas) { foreach my $channel_data (@$channel_datas) {

7
lib/PBot/Core/AntiSpam.pm
View File

@ -10,9 +10,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
my $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spam_keywords'; my $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spam_keywords';
$self->{keywords} = PBot::Core::Storage::DualIndexHashObject->new( $self->{keywords} = PBot::Core::Storage::DualIndexHashObject->new(
@ -26,8 +24,7 @@ sub initialize {
$self->{pbot}->{registry}->add_default('text', 'antispam', 'enforce', $conf{enforce_antispam} // 1); $self->{pbot}->{registry}->add_default('text', 'antispam', 'enforce', $conf{enforce_antispam} // 1);
} }
sub is_spam { sub is_spam($self, $namespace, $text, $all_namespaces = 0) {
my ($self, $namespace, $text, $all_namespaces) = @_;
my $lc_namespace = lc $namespace; my $lc_namespace = lc $namespace;
return 0 if not $self->{pbot}->{registry}->get_value('antispam', 'enforce'); return 0 if not $self->{pbot}->{registry}->get_value('antispam', 'enforce');

8
lib/PBot/Core/Applets.pm
View File

@ -21,9 +21,7 @@ sub initialize {
# nothing to do here # nothing to do here
} }
sub execute_applet { sub execute_applet($self, $context) {
my ($self, $context) = @_;
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper; use Data::Dumper;
$Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
@ -34,9 +32,7 @@ sub execute_applet {
$self->{pbot}->{process_manager}->execute_process($context, sub { $self->launch_applet(@_) }); $self->{pbot}->{process_manager}->execute_process($context, sub { $self->launch_applet(@_) });
} }
sub launch_applet { sub launch_applet($self, $context) {
my ($self, $context) = @_;
$context->{arguments} //= ''; $context->{arguments} //= '';
my @factoids = $self->{pbot}->{factoids}->{data}->find($context->{from}, $context->{keyword}, exact_channel => 2, exact_trigger => 2); my @factoids = $self->{pbot}->{factoids}->{data}->find($context->{from}, $context->{keyword}, exact_channel => 2, exact_trigger => 2);

71
lib/PBot/Core/BanList.pm
View File

@ -18,9 +18,7 @@ use Time::HiRes qw/gettimeofday/;
use Time::Duration; use Time::Duration;
use POSIX qw/strftime/; use POSIX qw/strftime/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('text', 'banlist', 'chanserv_ban_timeout', '604800'); $self->{pbot}->{registry}->add_default('text', 'banlist', 'chanserv_ban_timeout', '604800');
$self->{pbot}->{registry}->add_default('text', 'banlist', 'mute_timeout', '604800'); $self->{pbot}->{registry}->add_default('text', 'banlist', 'mute_timeout', '604800');
$self->{pbot}->{registry}->add_default('text', 'banlist', 'debug', '0'); $self->{pbot}->{registry}->add_default('text', 'banlist', 'debug', '0');
@ -61,9 +59,7 @@ sub initialize {
$self->{pbot}->{event_queue}->enqueue(sub { $self->flush_unban_queue }, 30, 'Flush unban queue'); $self->{pbot}->{event_queue}->enqueue(sub { $self->flush_unban_queue }, 30, 'Flush unban queue');
} }
sub checkban { sub checkban($self, $channel, $mode, $mask) {
my ($self, $channel, $mode, $mask) = @_;
$mask = $self->nick_to_banmask($mask); $mask = $self->nick_to_banmask($mask);
my $data; my $data;
@ -97,15 +93,12 @@ sub checkban {
return $result; return $result;
} }
sub is_ban_exempted { sub is_ban_exempted($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
return 1 if $self->{'ban-exemptions'}->exists(lc $channel, lc $hostmask); return 1 if $self->{'ban-exemptions'}->exists(lc $channel, lc $hostmask);
return 0; return 0;
} }
sub is_banned { sub is_banned($self, $channel, $nick, $user, $host) {
my ($self, $channel, $nick, $user, $host) = @_;
my $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); my $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my @nickserv_accounts = $self->{pbot}->{messagehistory}->{database}->get_nickserv_accounts($message_account); my @nickserv_accounts = $self->{pbot}->{messagehistory}->{database}->get_nickserv_accounts($message_account);
push @nickserv_accounts, undef; push @nickserv_accounts, undef;
@ -137,11 +130,7 @@ sub is_banned {
return $banned; return $banned;
} }
sub has_ban_timeout { sub has_ban_timeout($self, $channel, $mask, $mode = 'b') {
my ($self, $channel, $mask, $mode) = @_;
$mode ||= 'b';
my $list = $mode eq 'b' ? $self->{banlist} : $self->{quietlist}; my $list = $mode eq 'b' ? $self->{banlist} : $self->{quietlist};
my $data = $list->get_data($channel, $mask); my $data = $list->get_data($channel, $mask);
@ -153,9 +142,7 @@ sub has_ban_timeout {
} }
} }
sub ban_user_timed { sub ban_user_timed($self, $channel, $mode, $mask, $length, $owner, $reason, $immediately = 0) {
my ($self, $channel, $mode, $mask, $length, $owner, $reason, $immediately) = @_;
$channel = lc $channel; $channel = lc $channel;
$mask = lc $mask; $mask = lc $mask;
@ -185,28 +172,22 @@ sub ban_user_timed {
} }
} }
sub ban_user { sub ban_user($self, $channel, $mode, $mask, $immediately = 0) {
my ($self, $channel, $mode, $mask, $immediately) = @_;
$mode ||= 'b';
$self->{pbot}->{logger}->log("Banning $channel +$mode $mask\n"); $self->{pbot}->{logger}->log("Banning $channel +$mode $mask\n");
$self->add_to_ban_queue($channel, $mode, $mask); $self->add_to_ban_queue($channel, $mode, $mask);
if (not defined $immediately or $immediately != 0) { if ($immediately) {
$self->flush_ban_queue; $self->flush_ban_queue;
} }
} }
sub unban_user { sub unban_user($self, $channel, $mode, $mask, $immediately = 0) {
my ($self, $channel, $mode, $mask, $immediately) = @_;
$mask = lc $mask; $mask = lc $mask;
$channel = lc $channel; $channel = lc $channel;
$mode ||= 'b';
$self->{pbot}->{logger}->log("Unbanning $channel -$mode $mask\n"); $self->{pbot}->{logger}->log("Unbanning $channel -$mode $mask\n");
$self->unmode_user($channel, $mode, $mask, $immediately); $self->unmode_user($channel, $mode, $mask, $immediately);
} }
sub unmode_user { sub unmode_user($self, $channel, $mode, $mask, $immediately = 0) {
my ($self, $channel, $mode, $mask, $immediately) = @_;
$mask = lc $mask; $mask = lc $mask;
$channel = lc $channel; $channel = lc $channel;
$self->{pbot}->{logger}->log("Removing mode $mode from $mask in $channel\n"); $self->{pbot}->{logger}->log("Removing mode $mode from $mask in $channel\n");
@ -228,9 +209,7 @@ sub unmode_user {
$self->flush_unban_queue if $immediately; $self->flush_unban_queue if $immediately;
} }
sub get_bans { sub get_bans($self, $channel, $mask) {
my ($self, $channel, $mask) = @_;
my $masks; my $masks;
my ($message_account, $hostmask); my ($message_account, $hostmask);
@ -264,8 +243,7 @@ sub get_bans {
return $masks; return $masks;
} }
sub get_baninfo { sub get_baninfo($self, $channel, $mask, $nickserv) {
my ($self, $channel, $mask, $nickserv) = @_;
my ($bans, $ban_nickserv); my ($bans, $ban_nickserv);
$nickserv = undef if not length $nickserv; $nickserv = undef if not length $nickserv;
@ -334,9 +312,7 @@ sub get_baninfo {
return $bans; return $bans;
} }
sub nick_to_banmask { sub nick_to_banmask($self, $mask) {
my ($self, $mask) = @_;
if ($mask !~ m/[!@\$]/) { if ($mask !~ m/[!@\$]/) {
my ($message_account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($mask); my ($message_account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($mask);
if (defined $hostmask) { if (defined $hostmask) {
@ -369,25 +345,21 @@ sub nick_to_banmask {
return $mask; return $mask;
} }
sub add_to_ban_queue { sub add_to_ban_queue($self, $channel, $mode, $mask) {
my ($self, $channel, $mode, $mask) = @_;
if (not grep { $_ eq $mask } @{$self->{ban_queue}->{$channel}->{$mode}}) { if (not grep { $_ eq $mask } @{$self->{ban_queue}->{$channel}->{$mode}}) {
push @{$self->{ban_queue}->{$channel}->{$mode}}, $mask; push @{$self->{ban_queue}->{$channel}->{$mode}}, $mask;
$self->{pbot}->{logger}->log("Added +$mode $mask for $channel to ban queue.\n"); $self->{pbot}->{logger}->log("Added +$mode $mask for $channel to ban queue.\n");
} }
} }
sub add_to_unban_queue { sub add_to_unban_queue($self, $channel, $mode, $mask) {
my ($self, $channel, $mode, $mask) = @_;
if (not grep { $_ eq $mask } @{$self->{unban_queue}->{$channel}->{$mode}}) { if (not grep { $_ eq $mask } @{$self->{unban_queue}->{$channel}->{$mode}}) {
push @{$self->{unban_queue}->{$channel}->{$mode}}, $mask; push @{$self->{unban_queue}->{$channel}->{$mode}}, $mask;
$self->{pbot}->{logger}->log("Added -$mode $mask for $channel to unban queue.\n"); $self->{pbot}->{logger}->log("Added -$mode $mask for $channel to unban queue.\n");
} }
} }
sub flush_ban_queue { sub flush_ban_queue($self) {
my $self = shift;
my $MAX_COMMANDS = 4; my $MAX_COMMANDS = 4;
my $commands = 0; my $commands = 0;
@ -428,9 +400,7 @@ sub flush_ban_queue {
} }
} }
sub flush_unban_queue { sub flush_unban_queue($self) {
my $self = shift;
my $MAX_COMMANDS = 4; my $MAX_COMMANDS = 4;
my $commands = 0; my $commands = 0;
@ -471,9 +441,7 @@ sub flush_unban_queue {
} }
} }
sub enqueue_unban { sub enqueue_unban($self, $channel, $mode, $hostmask, $interval) {
my ($self, $channel, $mode, $hostmask, $interval) = @_;
my $method = $mode eq 'b' ? 'unban' : 'unmute'; my $method = $mode eq 'b' ? 'unban' : 'unmute';
$self->{pbot}->{event_queue}->enqueue_event( $self->{pbot}->{event_queue}->enqueue_event(
@ -485,8 +453,7 @@ sub enqueue_unban {
); );
} }
sub enqueue_timeouts { sub enqueue_timeouts($self, $list, $mode) {
my ($self, $list, $mode) = @_;
my $now = time; my $now = time;
foreach my $channel ($list->get_keys) { foreach my $channel ($list->get_keys) {

25
lib/PBot/Core/BlackList.pm
View File

@ -10,22 +10,18 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{filename} = $conf{filename}; $self->{filename} = $conf{filename};
$self->{storage} = {}; $self->{storage} = {};
$self->load; $self->load;
} }
sub add { sub add($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
$self->{storage}->{lc $channel}->{lc $hostmask} = 1; $self->{storage}->{lc $channel}->{lc $hostmask} = 1;
$self->save; $self->save;
} }
sub remove { sub remove($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
$channel = lc $channel; $channel = lc $channel;
$hostmask = lc $hostmask; $hostmask = lc $hostmask;
@ -40,14 +36,11 @@ sub remove {
$self->save; $self->save;
} }
sub clear { sub clear($self) {
my ($self) = @_;
$self->{storage} = {}; $self->{storage} = {};
} }
sub load { sub load($self) {
my ($self) = @_;
if (not $self->{filename}) { if (not $self->{filename}) {
$self->{pbot}->{logger}->log("No blacklist path specified -- skipping loading of blacklist"); $self->{pbot}->{logger}->log("No blacklist path specified -- skipping loading of blacklist");
return; return;
@ -81,9 +74,7 @@ sub load {
$self->{pbot}->{logger}->log(" $i entries in blacklist\n"); $self->{pbot}->{logger}->log(" $i entries in blacklist\n");
} }
sub save { sub save($self) {
my ($self) = @_;
if (not $self->{filename}) { if (not $self->{filename}) {
$self->{pbot}->{logger}->log("No blacklist path specified -- skipping saving of blacklist\n"); $self->{pbot}->{logger}->log("No blacklist path specified -- skipping saving of blacklist\n");
return; return;
@ -100,9 +91,7 @@ sub save {
close FILE; close FILE;
} }
sub is_blacklisted { sub is_blacklisted($self, $hostmask, $channel, $nickserv = undef, $gecos = undef) {
my ($self, $hostmask, $channel, $nickserv, $gecos) = @_;
return 0 if not defined $channel; return 0 if not defined $channel;
my $result = eval { my $result = eval {

33
lib/PBot/Core/Capabilities.pm
View File

@ -10,9 +10,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# capabilities file # capabilities file
my $filename = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/capabilities'; my $filename = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/capabilities';
@ -34,8 +32,7 @@ sub initialize {
$self->add('is-whitelisted', undef, 1); $self->add('is-whitelisted', undef, 1);
} }
sub has { sub has($self, $cap, $subcap, $depth = 10) {
my ($self, $cap, $subcap, $depth) = @_;
my $cap_data = $self->{caps}->get_data($cap); my $cap_data = $self->{caps}->get_data($cap);
return 0 if not defined $cap_data; return 0 if not defined $cap_data;
@ -45,8 +42,6 @@ sub has {
return 1; return 1;
} }
$depth //= 10; # set depth to 10 if it's not defined
if (--$depth <= 0) { if (--$depth <= 0) {
$self->{pbot}->{logger}->log("Max recursion reached for PBot::Core::Capabilities->has($cap, $subcap)\n"); $self->{pbot}->{logger}->log("Max recursion reached for PBot::Core::Capabilities->has($cap, $subcap)\n");
return 0; return 0;
@ -60,9 +55,7 @@ sub has {
return 0; return 0;
} }
sub userhas { sub userhas($self, $user, $cap) {
my ($self, $user, $cap) = @_;
return 0 if not defined $user; return 0 if not defined $user;
return 1 if $user->{$cap}; return 1 if $user->{$cap};
@ -75,9 +68,7 @@ sub userhas {
return 0; return 0;
} }
sub exists { sub exists($self, $cap) {
my ($self, $cap) = @_;
$cap = lc $cap; $cap = lc $cap;
foreach my $c ($self->{caps}->get_keys) { foreach my $c ($self->{caps}->get_keys) {
@ -91,9 +82,7 @@ sub exists {
return 0; return 0;
} }
sub add { sub add($self, $cap, $subcap, $dontsave = 0) {
my ($self, $cap, $subcap, $dontsave) = @_;
$cap = lc $cap; $cap = lc $cap;
if (not defined $subcap) { if (not defined $subcap) {
@ -109,9 +98,7 @@ sub add {
} }
} }
sub remove { sub remove($self, $cap, $subcap) {
my ($self, $cap, $subcap) = @_;
$cap = lc $cap; $cap = lc $cap;
if (not defined $subcap) { if (not defined $subcap) {
@ -128,9 +115,7 @@ sub remove {
$self->{caps}->save; $self->{caps}->save;
} }
sub rebuild_botowner_capabilities { sub rebuild_botowner_capabilities($self) {
my ($self) = @_;
$self->{caps}->remove('botowner', undef, 1); $self->{caps}->remove('botowner', undef, 1);
foreach my $cap ($self->{caps}->get_keys) { foreach my $cap ($self->{caps}->get_keys) {
@ -138,9 +123,7 @@ sub rebuild_botowner_capabilities {
} }
} }
sub list { sub list($self, $capability) {
my ($self, $capability) = @_;
if (defined $capability and not $self->{caps}->exists($capability)) { if (defined $capability and not $self->{caps}->exists($capability)) {
return "No such capability $capability."; return "No such capability $capability.";
} }

22
lib/PBot/Core/ChanOps.pm
View File

@ -19,9 +19,7 @@ use PBot::Imports;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
use Time::Duration qw(concise duration); use Time::Duration qw(concise duration);
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{op_commands} = {}; # OP command queue $self->{op_commands} = {}; # OP command queue
$self->{op_requested} = {}; # channels PBot has requested OP $self->{op_requested} = {}; # channels PBot has requested OP
$self->{is_opped} = {}; # channels PBot is currently OP $self->{is_opped} = {}; # channels PBot is currently OP
@ -34,8 +32,7 @@ sub initialize {
} }
# returns true if PBot can gain OP status in $channel # returns true if PBot can gain OP status in $channel
sub can_gain_ops { sub can_gain_ops($self, $channel) {
my ($self, $channel) = @_;
return return
$self->{pbot}->{channels}->{storage}->exists($channel) $self->{pbot}->{channels}->{storage}->exists($channel)
&& $self->{pbot}->{channels}->{storage}->get_data($channel, 'chanop') && $self->{pbot}->{channels}->{storage}->get_data($channel, 'chanop')
@ -43,8 +40,7 @@ sub can_gain_ops {
} }
# sends request to gain OP status in $channel # sends request to gain OP status in $channel
sub gain_ops { sub gain_ops($self, $channel) {
my ($self, $channel) = @_;
$channel = lc $channel; $channel = lc $channel;
return if exists $self->{op_requested}->{$channel}; return if exists $self->{op_requested}->{$channel};
@ -71,22 +67,19 @@ sub gain_ops {
} }
# removes OP status in $channel # removes OP status in $channel
sub lose_ops { sub lose_ops($self, $channel) {
my ($self, $channel) = @_;
$channel = lc $channel; $channel = lc $channel;
$self->{pbot}->{conn}->mode($channel, '-o ' . $self->{pbot}->{registry}->get_value('irc', 'botnick')); $self->{pbot}->{conn}->mode($channel, '-o ' . $self->{pbot}->{registry}->get_value('irc', 'botnick'));
} }
# adds a command to the OP command queue # adds a command to the OP command queue
sub add_op_command { sub add_op_command($self, $channel, $command) {
my ($self, $channel, $command) = @_;
return if not $self->can_gain_ops($channel); return if not $self->can_gain_ops($channel);
push @{$self->{op_commands}->{lc $channel}}, $command; push @{$self->{op_commands}->{lc $channel}}, $command;
} }
# invokes commands in OP command queue # invokes commands in OP command queue
sub perform_op_commands { sub perform_op_commands($self, $channel) {
my ($self, $channel) = @_;
$channel = lc $channel; $channel = lc $channel;
$self->{pbot}->{logger}->log("Performing op commands in $channel:\n"); $self->{pbot}->{logger}->log("Performing op commands in $channel:\n");
@ -112,8 +105,7 @@ sub perform_op_commands {
} }
# manages OP-related timeouts # manages OP-related timeouts
sub check_opped_timeouts { sub check_opped_timeouts($self) {
my $self = shift;
my $now = gettimeofday(); my $now = gettimeofday();
foreach my $channel (keys %{$self->{is_opped}}) { foreach my $channel (keys %{$self->{is_opped}}) {
if ($self->{is_opped}->{$channel}{timeout} < $now) { if ($self->{is_opped}->{$channel}{timeout} < $now) {

25
lib/PBot/Core/Channels.pm
View File

@ -10,9 +10,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{storage} = PBot::Core::Storage::HashObject->new( $self->{storage} = PBot::Core::Storage::HashObject->new(
pbot => $self->{pbot}, pbot => $self->{pbot},
name => 'Channels', name => 'Channels',
@ -30,9 +28,7 @@ sub initialize {
); );
} }
sub join { sub join($self, $channels) {
my ($self, $channels) = @_;
return if not $channels; return if not $channels;
$self->{pbot}->{conn}->join($channels); $self->{pbot}->{conn}->join($channels);
@ -44,16 +40,13 @@ sub join {
} }
} }
sub part { sub part($self, $channel) {
my ($self, $channel) = @_;
$channel = lc $channel; $channel = lc $channel;
$self->{pbot}->{event_dispatcher}->dispatch_event('pbot.part', { channel => $channel }); $self->{pbot}->{event_dispatcher}->dispatch_event('pbot.part', { channel => $channel });
$self->{pbot}->{conn}->part($channel); $self->{pbot}->{conn}->part($channel);
} }
sub autojoin { sub autojoin($self) {
my ($self) = @_;
return if $self->{pbot}->{joined_channels}; return if $self->{pbot}->{joined_channels};
my $channels; my $channels;
@ -71,19 +64,15 @@ sub autojoin {
$self->{pbot}->{joined_channels} = 1; $self->{pbot}->{joined_channels} = 1;
} }
sub is_active { sub is_active($self, $channel) {
my ($self, $channel) = @_;
# returns undef if channel doesn't exist; otherwise, the value of 'enabled'
return $self->{storage}->get_data($channel, 'enabled'); return $self->{storage}->get_data($channel, 'enabled');
} }
sub is_active_op { sub is_active_op($self, $channel) {
my ($self, $channel) = @_;
return $self->is_active($channel) && $self->{storage}->get_data($channel, 'chanop'); return $self->is_active($channel) && $self->{storage}->get_data($channel, 'chanop');
} }
sub get_meta { sub get_meta($self, $channel, $key) {
my ($self, $channel, $key) = @_;
return $self->{storage}->get_data($channel, $key); return $self->{storage}->get_data($channel, $key);
} }

8
lib/PBot/Core/Class.pm
View File

@ -12,18 +12,14 @@ use PBot::Imports;
my %import_opts; my %import_opts;
sub import { sub import($package, %opts) {
my ($package, %opts) = @_;
if (%opts) { if (%opts) {
# set import options for package # set import options for package
$import_opts{$package} = \%opts; $import_opts{$package} = \%opts;
} }
} }
sub new { sub new($class, %args) {
my ($class, %args) = @_;
# ensure class was passed a PBot instance # ensure class was passed a PBot instance
if (not exists $args{pbot}) { if (not exists $args{pbot}) {
my ($package, $filename, $line) = caller(0); my ($package, $filename, $line) = caller(0);

38
lib/PBot/Core/Commands.pm
View File

@ -12,9 +12,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
use PBot::Core::Utils::LoadModules qw/load_modules/; use PBot::Core::Utils::LoadModules qw/load_modules/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# registered commands hashtable # registered commands hashtable
$self->{commands} = {}; $self->{commands} = {};
@ -29,16 +27,13 @@ sub initialize {
} }
# load commands in PBot::Core::Commands directory # load commands in PBot::Core::Commands directory
sub load_commands { sub load_commands($self) {
my ($self) = @_;
$self->{pbot}->{logger}->log("Loading commands:\n"); $self->{pbot}->{logger}->log("Loading commands:\n");
load_modules($self, 'PBot::Core::Commands'); load_modules($self, 'PBot::Core::Commands');
} }
# named-parameters interface to register() # named-parameters interface to register()
sub add { sub add($self, %args) {
my ($self, %args) = @_;
# expected parameters # expected parameters
my @valid = qw(subref name requires_cap help); my @valid = qw(subref name requires_cap help);
@ -66,21 +61,16 @@ sub add {
} }
# alias to unregister() for consistency # alias to unregister() for consistency
sub remove { sub remove($self, @args) {
my $self = shift @_; $self->unregister(@args);
$self->unregister(@_);
} }
sub register { sub register($self, $subref, $name, $requires_cap = 0, $help = '') {
my ($self, $subref, $name, $requires_cap, $help) = @_;
if (not defined $subref or not defined $name) { if (not defined $subref or not defined $name) {
Carp::croak("Missing parameters to Commands::register"); Carp::croak("Missing parameters to Commands::register");
} }
$name = lc $name; $name = lc $name;
$requires_cap //= 0;
$help //= '';
if (exists $self->{commands}->{$name}) { if (exists $self->{commands}->{$name}) {
$self->{pbot}->{logger}->log("Commands: warning: overwriting existing command $name\n"); $self->{pbot}->{logger}->log("Commands: warning: overwriting existing command $name\n");
@ -117,34 +107,28 @@ sub register {
} }
} }
sub unregister { sub unregister($self, $name) {
my ($self, $name) = @_;
Carp::croak("Missing name parameter to Commands::unregister") if not defined $name; Carp::croak("Missing name parameter to Commands::unregister") if not defined $name;
delete $self->{commands}->{lc $name}; delete $self->{commands}->{lc $name};
} }
sub exists { sub exists($self, $name) {
my ($self, $name) = @_;
return exists $self->{commands}->{lc $name}; return exists $self->{commands}->{lc $name};
} }
sub set_meta { sub set_meta($self, $command, $key, $value, $save = 0) {
my ($self, $command, $key, $value, $save) = @_;
return undef if not $self->{metadata}->exists($command); return undef if not $self->{metadata}->exists($command);
$self->{metadata}->set($command, $key, $value, !$save); $self->{metadata}->set($command, $key, $value, !$save);
return 1; return 1;
} }
sub get_meta { sub get_meta($self, $command, $key) {
my ($self, $command, $key) = @_;
return $self->{metadata}->get_data($command, $key); return $self->{metadata}->get_data($command, $key);
} }
# main entry point for PBot::Core::Interpreter to interpret a registered bot command # main entry point for PBot::Core::Interpreter to interpret a registered bot command
# see also PBot::Core::Factoids::Interpreter for factoid commands # see also PBot::Core::Factoids::Interpreter for factoid commands
sub interpreter { sub interpreter($self, $context) {
my ($self, $context) = @_;
# debug flag to trace $context location and contents # debug flag to trace $context location and contents
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper; use Data::Dumper;

8
lib/PBot/Core/Commands/AntiSpam.pm
View File

@ -13,18 +13,14 @@ use PBot::Imports;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
use POSIX qw/strftime/; use POSIX qw/strftime/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_antispam(@_) }, "antispam", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_antispam(@_) }, "antispam", 1);
# add capability to admin group # add capability to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-antispam', 1); $self->{pbot}->{capabilities}->add('admin', 'can-antispam', 1);
} }
sub cmd_antispam { sub cmd_antispam($self, $context) {
my ($self, $context) = @_;
my $arglist = $context->{arglist}; my $arglist = $context->{arglist};
my $command = $self->{pbot}->{interpreter}->shift_arg($arglist); my $command = $self->{pbot}->{interpreter}->shift_arg($arglist);

12
lib/PBot/Core/Commands/Applets.pm
View File

@ -13,17 +13,13 @@ use PBot::Imports;
use IPC::Run qw/run timeout/; use IPC::Run qw/run timeout/;
use Encode; use Encode;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# bot commands to load and unload applets # bot commands to load and unload applets
$self->{pbot}->{commands}->register(sub { $self->cmd_load(@_) }, "load", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_load(@_) }, "load", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unload(@_) }, "unload", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_unload(@_) }, "unload", 1);
} }
sub cmd_load { sub cmd_load($self, $context) {
my ($self, $context) = @_;
my ($keyword, $applet) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($keyword, $applet) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: load <keyword> <applet>" if not defined $applet; return "Usage: load <keyword> <applet>" if not defined $applet;
@ -44,9 +40,7 @@ sub cmd_load {
return "Loaded applet $keyword => $applet"; return "Loaded applet $keyword => $applet";
} }
sub cmd_unload { sub cmd_unload($self, $context) {
my ($self, $context) = @_;
my $applet = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); my $applet = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
return "Usage: unload <keyword>" if not defined $applet; return "Usage: unload <keyword>" if not defined $applet;

20
lib/PBot/Core/Commands/BanList.pm
View File

@ -16,9 +16,7 @@ use Time::HiRes qw/gettimeofday/;
use Time::Duration; use Time::Duration;
use POSIX qw/strftime/; use POSIX qw/strftime/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_banlist(@_) }, "banlist", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_banlist(@_) }, "banlist", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_checkban(@_) }, "checkban", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_checkban(@_) }, "checkban", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_checkmute(@_) }, "checkmute", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_checkmute(@_) }, "checkmute", 0);
@ -30,9 +28,7 @@ sub initialize {
} }
sub cmd_banlist { sub cmd_banlist($self, $context) {
my ($self, $context) = @_;
if (not length $context->{arguments}) { if (not length $context->{arguments}) {
return "Usage: banlist <channel>"; return "Usage: banlist <channel>";
} }
@ -93,8 +89,7 @@ sub cmd_banlist {
return $result; return $result;
} }
sub cmd_checkban { sub cmd_checkban($self, $context) {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkban <mask> [channel]" if not defined $target; return "Usage: checkban <mask> [channel]" if not defined $target;
@ -104,8 +99,7 @@ sub cmd_checkban {
return $self->{pbot}->{banlist}->checkban($channel, 'b', $target); return $self->{pbot}->{banlist}->checkban($channel, 'b', $target);
} }
sub cmd_checkmute { sub cmd_checkmute($self, $context) {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkmute <mask> [channel]" if not defined $target; return "Usage: checkmute <mask> [channel]" if not defined $target;
@ -115,8 +109,7 @@ sub cmd_checkmute {
return $self->{pbot}->{banlist}->checkban($channel, $self->{pbot}->{registry}->get_value('banlist', 'mute_mode_char'), $target); return $self->{pbot}->{banlist}->checkban($channel, $self->{pbot}->{registry}->get_value('banlist', 'mute_mode_char'), $target);
} }
sub cmd_unbanme { sub cmd_unbanme($self, $context) {
my ($self, $context) = @_;
my $unbanned; my $unbanned;
my %aliases = $self->{pbot}->{messagehistory}->{database}->get_also_known_as($context->{nick}); my %aliases = $self->{pbot}->{messagehistory}->{database}->get_also_known_as($context->{nick});
@ -226,8 +219,7 @@ sub cmd_unbanme {
} }
} }
sub cmd_ban_exempt { sub cmd_ban_exempt($self, $context) {
my ($self, $context) = @_;
my $arglist = $context->{arglist}; my $arglist = $context->{arglist};
$self->{pbot}->{interpreter}->lc_args($arglist); $self->{pbot}->{interpreter}->lc_args($arglist);

8
lib/PBot/Core/Commands/BlackList.pm
View File

@ -11,18 +11,14 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_blacklist(@_) }, "blacklist", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_blacklist(@_) }, "blacklist", 1);
# add capability to admin group # add capability to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-blacklist', 1); $self->{pbot}->{capabilities}->add('admin', 'can-blacklist', 1);
} }
sub cmd_blacklist { sub cmd_blacklist($self, $context) {
my ($self, $context) = @_;
my $arglist = $context->{arglist}; my $arglist = $context->{arglist};
$self->{pbot}->{interpreter}->lc_args($arglist); $self->{pbot}->{interpreter}->lc_args($arglist);

7
lib/PBot/Core/Commands/Capabilities.pm
View File

@ -10,14 +10,11 @@ package PBot::Core::Commands::Capabilities;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_cap(@_) }, "cap"); $self->{pbot}->{commands}->register(sub { $self->cmd_cap(@_) }, "cap");
} }
sub cmd_cap { sub cmd_cap($self, $context) {
my ($self, $context) = @_;
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
given ($command) { given ($command) {

56
lib/PBot/Core/Commands/ChanOp.pm
View File

@ -13,9 +13,7 @@ use parent 'PBot::Core::Class';
use Time::Duration; use Time::Duration;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register commands # register commands
$self->{pbot}->{commands}->register(sub { $self->cmd_op(@_) }, "op", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_op(@_) }, "op", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_deop(@_) }, "deop", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_deop(@_) }, "deop", 1);
@ -87,9 +85,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.nosuchnick', sub { $self->on_nosuchnick(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.nosuchnick', sub { $self->on_nosuchnick(@_) });
} }
sub on_inviting { sub on_inviting($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($botnick, $target, $channel) = $event->args; my ($botnick, $target, $channel) = $event->args;
$self->{pbot}->{logger}->log("User $target invited to channel $channel.\n"); $self->{pbot}->{logger}->log("User $target invited to channel $channel.\n");
@ -104,9 +100,7 @@ sub on_inviting {
return 1; return 1;
} }
sub on_useronchannel { sub on_useronchannel($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($botnick, $target, $channel) = $event->args; my ($botnick, $target, $channel) = $event->args;
$self->{pbot}->{logger}->log("User $target is already on channel $channel.\n"); $self->{pbot}->{logger}->log("User $target is already on channel $channel.\n");
@ -121,9 +115,7 @@ sub on_useronchannel {
return 1; return 1;
} }
sub on_nosuchnick { sub on_nosuchnick($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($botnick, $target, $msg) = $event->args; my ($botnick, $target, $msg) = $event->args;
$self->{pbot}->{logger}->log("$target: $msg\n"); $self->{pbot}->{logger}->log("$target: $msg\n");
@ -142,8 +134,7 @@ sub on_nosuchnick {
return 1; return 1;
} }
sub cmd_invite { sub cmd_invite($self, $context) {
my ($self, $context) = @_;
my ($channel, $target); my ($channel, $target);
if ($context->{from} !~ m/^#/) { if ($context->{from} !~ m/^#/) {
@ -168,8 +159,7 @@ sub cmd_invite {
return ""; # responses handled by events return ""; # responses handled by events
} }
sub generic_mode { sub generic_mode($self, $mode_flag, $mode_name, $context) {
my ($self, $mode_flag, $mode_name, $context) = @_;
my $result = ''; my $result = '';
my $channel = $context->{from}; my $channel = $context->{from};
@ -220,29 +210,23 @@ sub generic_mode {
return $result; return $result;
} }
sub cmd_op { sub cmd_op($self, $context) {
my ($self, $context) = @_;
return $self->generic_mode('+o', 'op', $context); return $self->generic_mode('+o', 'op', $context);
} }
sub cmd_deop { sub cmd_deop($self, $context) {
my ($self, $context) = @_;
return $self->generic_mode('-o', 'deop', $context); return $self->generic_mode('-o', 'deop', $context);
} }
sub cmd_voice { sub cmd_voice($self, $context) {
my ($self, $context) = @_;
return $self->generic_mode('+v', 'voice', $context); return $self->generic_mode('+v', 'voice', $context);
} }
sub cmd_devoice { sub cmd_devoice($self, $context) {
my ($self, $context) = @_;
return $self->generic_mode('-v', 'devoice', $context); return $self->generic_mode('-v', 'devoice', $context);
} }
sub cmd_mode { sub cmd_mode($self, $context) {
my ($self, $context) = @_;
if (not length $context->{arguments}) { return "Usage: mode [channel] <arguments>"; } if (not length $context->{arguments}) { return "Usage: mode [channel] <arguments>"; }
# add current channel as default channel # add current channel as default channel
@ -352,8 +336,7 @@ sub cmd_mode {
else { return ""; } else { return ""; }
} }
sub cmd_ban { sub cmd_ban($self, $context) {
my ($self, $context) = @_;
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
$channel = '' if not defined $channel; $channel = '' if not defined $channel;
@ -431,9 +414,7 @@ sub cmd_ban {
return $result; return $result;
} }
sub cmd_unban { sub cmd_unban($self, $context) {
my ($self, $context) = @_;
if (not defined $context->{from}) { if (not defined $context->{from}) {
$self->{pbot}->{logger}->log("Command missing ~from parameter!\n"); $self->{pbot}->{logger}->log("Command missing ~from parameter!\n");
return ""; return "";
@ -483,8 +464,7 @@ sub cmd_unban {
return "/msg $context->{nick} $target has been unbanned from $channel."; return "/msg $context->{nick} $target has been unbanned from $channel.";
} }
sub cmd_mute { sub cmd_mute($self, $context) {
my ($self, $context) = @_;
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
$channel = '' if not defined $channel; $channel = '' if not defined $channel;
@ -564,9 +544,7 @@ sub cmd_mute {
return $result; return $result;
} }
sub cmd_unmute { sub cmd_unmute($self, $context) {
my ($self, $context) = @_;
if (not defined $context->{from}) { if (not defined $context->{from}) {
$self->{pbot}->{logger}->log("Command missing ~from parameter!\n"); $self->{pbot}->{logger}->log("Command missing ~from parameter!\n");
return ""; return "";
@ -613,9 +591,7 @@ sub cmd_unmute {
return "/msg $context->{nick} $target has been unmuted in $channel."; return "/msg $context->{nick} $target has been unmuted in $channel.";
} }
sub cmd_kick { sub cmd_kick($self, $context) {
my ($self, $context) = @_;
my ($channel, $victim, $reason); my ($channel, $victim, $reason);
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};

25
lib/PBot/Core/Commands/Channels.pm
View File

@ -10,9 +10,7 @@ package PBot::Core::Commands::Channels;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register commands # register commands
$self->{pbot}->{commands}->register(sub { $self->cmd_join(@_) }, "join", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_join(@_) }, "join", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_part(@_) }, "part", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_part(@_) }, "part", 1);
@ -28,8 +26,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-chanlist', 1); $self->{pbot}->{capabilities}->add('admin', 'can-chanlist', 1);
} }
sub cmd_join { sub cmd_join($self, $context) {
my ($self, $context) = @_;
foreach my $channel (split /[\s+,]/, $context->{arguments}) { foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me join $channel\n"); $self->{pbot}->{logger}->log("$context->{hostmask} made me join $channel\n");
$self->{pbot}->{channels}->join($channel); $self->{pbot}->{channels}->join($channel);
@ -37,8 +34,7 @@ sub cmd_join {
return "/msg $context->{nick} Joining $context->{arguments}"; return "/msg $context->{nick} Joining $context->{arguments}";
} }
sub cmd_part { sub cmd_part($self, $context) {
my ($self, $context) = @_;
$context->{arguments} = $context->{from} if not $context->{arguments}; $context->{arguments} = $context->{from} if not $context->{arguments};
foreach my $channel (split /[\s+,]/, $context->{arguments}) { foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me part $channel\n"); $self->{pbot}->{logger}->log("$context->{hostmask} made me part $channel\n");
@ -47,22 +43,19 @@ sub cmd_part {
return "/msg $context->{nick} Parting $context->{arguments}"; return "/msg $context->{nick} Parting $context->{arguments}";
} }
sub cmd_set { sub cmd_set($self, $context) {
my ($self, $context) = @_;
my ($channel, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); my ($channel, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
return "Usage: chanset <channel> [key [value]]" if not defined $channel; return "Usage: chanset <channel> [key [value]]" if not defined $channel;
return $self->{pbot}->{channels}->{storage}->set($channel, $key, $value); return $self->{pbot}->{channels}->{storage}->set($channel, $key, $value);
} }
sub cmd_unset { sub cmd_unset($self, $context) {
my ($self, $context) = @_;
my ($channel, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($channel, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: chanunset <channel> <key>" if not defined $channel or not defined $key; return "Usage: chanunset <channel> <key>" if not defined $channel or not defined $key;
return $self->{pbot}->{channels}->{storage}->unset($channel, $key); return $self->{pbot}->{channels}->{storage}->unset($channel, $key);
} }
sub cmd_add { sub cmd_add($self, $context) {
my ($self, $context) = @_;
return "Usage: chanadd <channel>" if not length $context->{arguments}; return "Usage: chanadd <channel>" if not length $context->{arguments};
my $data = { my $data = {
@ -74,8 +67,7 @@ sub cmd_add {
return $self->{pbot}->{channels}->{storage}->add($context->{arguments}, $data); return $self->{pbot}->{channels}->{storage}->add($context->{arguments}, $data);
} }
sub cmd_remove { sub cmd_remove($self, $context) {
my ($self, $context) = @_;
return "Usage: chanrem <channel>" if not length $context->{arguments}; return "Usage: chanrem <channel>" if not length $context->{arguments};
# clear banlists # clear banlists
@ -88,8 +80,7 @@ sub cmd_remove {
return $self->{pbot}->{channels}->{storage}->remove($context->{arguments}); return $self->{pbot}->{channels}->{storage}->remove($context->{arguments});
} }
sub cmd_list { sub cmd_list($self, $context) {
my ($self, $context) = @_;
my $result; my $result;
foreach my $channel (sort $self->{pbot}->{channels}->{storage}->get_keys) { foreach my $channel (sort $self->{pbot}->{channels}->{storage}->get_keys) {
$result .= $self->{pbot}->{channels}->{storage}->get_key_name($channel) . ': {'; $result .= $self->{pbot}->{channels}->{storage}->get_key_name($channel) . ': {';

12
lib/PBot/Core/Commands/CommandMetadata.pm
View File

@ -10,17 +10,13 @@ package PBot::Core::Commands::CommandMetadata;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register commands to manipulate command metadata # register commands to manipulate command metadata
$self->{pbot}->{commands}->register(sub { $self->cmd_set(@_) }, "cmdset", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_set(@_) }, "cmdset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unset(@_) }, "cmdunset", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_unset(@_) }, "cmdunset", 1);
} }
sub cmd_set { sub cmd_set($self, $context) {
my ($self, $context) = @_;
my ($command, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); my ($command, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $command) { if (not defined $command) {
@ -30,9 +26,7 @@ sub cmd_set {
return $self->{pbot}->{commands}->{metadata}->set($command, $key, $value); return $self->{pbot}->{commands}->{metadata}->set($command, $key, $value);
} }
sub cmd_unset { sub cmd_unset($self, $context) {
my ($self, $context) = @_;
my ($command, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($command, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $command or not defined $key) { if (not defined $command or not defined $key) {

8
lib/PBot/Core/Commands/EventQueue.pm
View File

@ -12,9 +12,7 @@ use parent 'PBot::Core::Class';
use Time::Duration; use Time::Duration;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register `eventqueue` bot command # register `eventqueue` bot command
$self->{pbot}->{commands}->register(sub { $self->cmd_eventqueue(@_) }, 'eventqueue', 1); $self->{pbot}->{commands}->register(sub { $self->cmd_eventqueue(@_) }, 'eventqueue', 1);
@ -22,9 +20,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-eventqueue', 1); $self->{pbot}->{capabilities}->add('admin', 'can-eventqueue', 1);
} }
sub cmd_eventqueue { sub cmd_eventqueue($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: eventqueue list [filter regex] | add <relative time> <command> [-repeat] | remove <regex>"; my $usage = "Usage: eventqueue list [filter regex] | add <relative time> <command> [-repeat] | remove <regex>";
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});

116
lib/PBot/Core/Commands/Factoids.pm
View File

@ -40,9 +40,7 @@ our %factoid_metadata_capabilities = (
# all others are allowed to be factset by anybody # all others are allowed to be factset by anybody
); );
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('text', 'general', 'applet_repo', $conf{applet_repo} $self->{pbot}->{registry}->add_default('text', 'general', 'applet_repo', $conf{applet_repo}
// 'https://github.com/pragma-/pbot/blob/master/applets/'); // 'https://github.com/pragma-/pbot/blob/master/applets/');
@ -69,8 +67,7 @@ sub initialize {
$self->{pbot}->{commands}->register(sub { $self->cmd_add_regex(@_) }, "regex", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_add_regex(@_) }, "regex", 1);
} }
sub cmd_call_factoid { sub cmd_call_factoid($self, $context) {
my ($self, $context) = @_;
my ($chan, $keyword, $args) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3, 0, 1); my ($chan, $keyword, $args) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3, 0, 1);
if (not defined $chan or not defined $keyword) { if (not defined $chan or not defined $keyword) {
@ -92,9 +89,7 @@ sub cmd_call_factoid {
return $self->{pbot}->{factoids}->{interpreter}->interpreter($context); return $self->{pbot}->{factoids}->{interpreter}->interpreter($context);
} }
sub cmd_as_factoid { sub cmd_as_factoid($self, $context) {
my ($self, $context) = @_;
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
my $usage = "Usage: factoid <text to interpret as a factoid> [--args 'arguments passed to factoid']"; my $usage = "Usage: factoid <text to interpret as a factoid> [--args 'arguments passed to factoid']";
@ -133,8 +128,7 @@ sub cmd_as_factoid {
return $result; return $result;
} }
sub cmd_factundo { sub cmd_factundo($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: factundo [-l [N]] [-r N] [channel] <keyword> (-l list undo history, optionally starting from N; -r jump to revision N)"; my $usage = "Usage: factundo [-l [N]] [-r N] [channel] <keyword> (-l list undo history, optionally starting from N; -r jump to revision N)";
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
@ -238,9 +232,7 @@ sub cmd_factundo {
return "[$channel_name] $trigger_name reverted (revision " . ($undos->{idx} + 1) . "): $changes\n"; return "[$channel_name] $trigger_name reverted (revision " . ($undos->{idx} + 1) . "): $changes\n";
} }
sub cmd_factredo { sub cmd_factredo($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: factredo [-l [N]] [-r N] [channel] <keyword> (-l list undo history, optionally starting from N; -r jump to revision N)"; my $usage = "Usage: factredo [-l [N]] [-r N] [channel] <keyword> (-l list undo history, optionally starting from N; -r jump to revision N)";
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
@ -332,9 +324,7 @@ sub cmd_factredo {
return "[$channel_name] $trigger_name restored (revision " . ($undos->{idx} + 1) . "): $changes\n"; return "[$channel_name] $trigger_name restored (revision " . ($undos->{idx} + 1) . "): $changes\n";
} }
sub cmd_factset { sub cmd_factset($self, $context) {
my ($self, $context) = @_;
my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel( my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel(
$context->{from}, $context->{arguments}, 'factset', usage => 'Usage: factset [channel] <factoid> [key [value]]', explicit => 1 $context->{from}, $context->{arguments}, 'factset', usage => 'Usage: factset [channel] <factoid> [key [value]]', explicit => 1
); );
@ -430,8 +420,7 @@ sub cmd_factset {
return $result; return $result;
} }
sub cmd_factunset { sub cmd_factunset($self, $context) {
my ($self, $context) = @_;
my $usage = 'Usage: factunset [channel] <factoid> <key>'; my $usage = 'Usage: factunset [channel] <factoid> <key>';
my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel( my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel(
@ -516,9 +505,7 @@ sub cmd_factunset {
return $result; return $result;
} }
sub cmd_factmove { sub cmd_factmove($self, $context) {
my ($self, $context) = @_;
my ($src_channel, $source, $target_channel, $target) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5); my ($src_channel, $source, $target_channel, $target) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5);
my $usage = "Usage: factmove <source channel> <source factoid> <target channel/factoid> [target factoid]"; my $usage = "Usage: factmove <source channel> <source factoid> <target channel/factoid> [target factoid]";
@ -614,8 +601,7 @@ sub cmd_factmove {
} }
} }
sub cmd_factalias { sub cmd_factalias($self, $context) {
my ($self, $context) = @_;
my ($chan, $alias, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3, 0, 1); my ($chan, $alias, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3, 0, 1);
if (defined $chan and not($chan eq '.*' or $chan =~ m/^#/)) { if (defined $chan and not($chan eq '.*' or $chan =~ m/^#/)) {
@ -657,8 +643,7 @@ sub cmd_factalias {
return "/say $alias aliases `$command` for " . ($chan eq '.*' ? 'the global channel' : $chan); return "/say $alias aliases `$command` for " . ($chan eq '.*' ? 'the global channel' : $chan);
} }
sub cmd_add_regex { sub cmd_add_regex($self, $context) {
my ($self, $context) = @_;
my ($keyword, $text) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($keyword, $text) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
my $channel = $context->{from}; my $channel = $context->{from};
@ -697,9 +682,7 @@ my @valid_pastesites = (
'https?://0x0.st', 'https?://0x0.st',
); );
sub cmd_factadd { sub cmd_factadd($self, $context) {
my ($self, $context) = @_;
my ($from_chan, $keyword, $text, $force); my ($from_chan, $keyword, $text, $force);
my @arglist = @{$context->{arglist}}; my @arglist = @{$context->{arglist}};
@ -819,8 +802,7 @@ sub cmd_factadd {
return "/say $keyword_text added to " . ($from_chan eq '.*' ? 'global channel' : $from_chan) . "."; return "/say $keyword_text added to " . ($from_chan eq '.*' ? 'global channel' : $from_chan) . ".";
} }
sub cmd_factrem { sub cmd_factrem($self, $context) {
my ($self, $context) = @_;
my $factoids = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my ($from_chan, $from_trig) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($from_chan, $from_trig) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
@ -860,9 +842,7 @@ sub cmd_factrem {
return '/say '. $self->{pbot}->{factoids}->{data}->remove($channel, $trigger); return '/say '. $self->{pbot}->{factoids}->{data}->remove($channel, $trigger);
} }
sub cmd_factshow { sub cmd_factshow($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: factshow [-p] [channel] <keyword>; -p to paste"; my $usage = "Usage: factshow [-p] [channel] <keyword>; -p to paste";
return $usage if not length $context->{arguments}; return $usage if not length $context->{arguments};
@ -909,9 +889,7 @@ sub cmd_factshow {
return $result; return $result;
} }
sub cmd_factlog { sub cmd_factlog($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: factlog [-h] [-t] [channel] <keyword>; -h show full hostmask; -t show actual timestamp instead of relative"; my $usage = "Usage: factlog [-h] [-t] [channel] <keyword>; -h show full hostmask; -t show actual timestamp instead of relative";
return $usage if not length $context->{arguments}; return $usage if not length $context->{arguments};
@ -993,8 +971,7 @@ sub cmd_factlog {
return $result; return $result;
} }
sub cmd_factinfo { sub cmd_factinfo($self, $context) {
my ($self, $context) = @_;
my $factoids = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my ($chan, $trig) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($chan, $trig) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
@ -1084,15 +1061,12 @@ sub cmd_factinfo {
return "/say $context->{arguments} is not a factoid or an applet."; return "/say $context->{arguments} is not a factoid or an applet.";
} }
sub quotemeta2 { sub quotemeta2($text) {
my ($text) = @_;
$text =~ s/(?<!\\) ([\[ \\ \| () { ^ \$ * + ? . ])/\\$1/gx; $text =~ s/(?<!\\) ([\[ \\ \| () { ^ \$ * + ? . ])/\\$1/gx;
return $text; return $text;
} }
sub cmd_factfind { sub cmd_factfind($self, $context) {
my ($self, $context) = @_;
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
my $usage = "Usage: factfind [-channel channel] [-owner regex] [-editby regex] [-refby regex] [-regex] [text]"; my $usage = "Usage: factfind [-channel channel] [-owner regex] [-editby regex] [-refby regex] [-regex] [text]";
@ -1212,8 +1186,7 @@ sub cmd_factfind {
} }
} }
sub cmd_factchange { sub cmd_factchange($self, $context) {
my ($self, $context) = @_;
my $factoids_data = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids_data = $self->{pbot}->{factoids}->{data}->{storage};
my ($channel, $trigger, $keyword, $delim, $tochange, $changeto, $modifier, $url); my ($channel, $trigger, $keyword, $delim, $tochange, $changeto, $modifier, $url);
@ -1400,8 +1373,7 @@ sub cmd_factchange {
return "Changed: $trigger_name is $action"; return "Changed: $trigger_name is $action";
} }
sub cmd_top20 { sub cmd_top20($self, $context) {
my ($self, $context) = @_;
my $factoids = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my %hash = (); my %hash = ();
my $text = ""; my $text = "";
@ -1420,6 +1392,7 @@ sub cmd_top20 {
} }
$channel = "the global channel" if $channel eq '.*'; $channel = "the global channel" if $channel eq '.*';
if ($i > 0) { if ($i > 0) {
return "Top $i referenced factoids for $channel: $text"; return "Top $i referenced factoids for $channel: $text";
} else { } else {
@ -1460,8 +1433,7 @@ sub cmd_top20 {
} }
} }
sub cmd_histogram { sub cmd_histogram($self, $context) {
my ($self, $context) = @_;
my $factoids = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my %owners; my %owners;
my $factoid_count = 0; my $factoid_count = 0;
@ -1485,8 +1457,7 @@ sub cmd_histogram {
return "/say $factoid_count factoids, top $top submitters:\n$text"; return "/say $factoid_count factoids, top $top submitters:\n$text";
} }
sub cmd_count { sub cmd_count($self, $context) {
my ($self, $context) = @_;
my $factoids = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my $i = 0; my $i = 0;
my $total = 0; my $total = 0;
@ -1518,9 +1489,7 @@ sub cmd_count {
} }
} }
sub log_factoid { sub log_factoid($self, $channel, $trigger, $hostmask, $msg, $dont_save_undo = 0) {
my ($self, $channel, $trigger, $hostmask, $msg, $dont_save_undo) = @_;
$channel = lc $channel; $channel = lc $channel;
$trigger = lc $trigger; $trigger = lc $trigger;
@ -1568,9 +1537,7 @@ sub log_factoid {
$self->{pbot}->{logger}->log("Error storing undo: $@\n") if $@; $self->{pbot}->{logger}->log("Error storing undo: $@\n") if $@;
} }
sub find_factoid_with_optional_channel { sub find_factoid_with_optional_channel($self, $from, $arguments, $command, %opts) {
my ($self, $from, $arguments, $command, %opts) = @_;
my %default_opts = ( my %default_opts = (
usage => undef, usage => undef,
explicit => 0, explicit => 0,
@ -1667,8 +1634,7 @@ sub find_factoid_with_optional_channel {
return ($channel, $trigger, $remaining_args); return ($channel, $trigger, $remaining_args);
} }
sub hash_differences_as_string { sub hash_differences_as_string($self, $old, $new) {
my ($self, $old, $new) = @_;
my @exclude = qw/created_on last_referenced_in last_referenced_on ref_count ref_user edited_by edited_on/; my @exclude = qw/created_on last_referenced_in last_referenced_on ref_count ref_user edited_by edited_on/;
my %diff; my %diff;
@ -1687,35 +1653,45 @@ sub hash_differences_as_string {
my $changes = ""; my $changes = "";
my $comma = ""; my $comma = "";
foreach my $key (sort keys %diff) { foreach my $key (sort keys %diff) {
if (defined $diff{$key}) { $changes .= "$comma$key => $diff{$key}"; } if (defined $diff{$key}) {
else { $changes .= "$comma$key"; } $changes .= "$comma$key => $diff{$key}";
} else {
$changes .= "$comma$key";
}
$comma = ", "; $comma = ", ";
} }
return $changes; return $changes;
} }
sub list_undo_history { sub list_undo_history($self, $undos, $start_from = undef) {
my ($self, $undos, $start_from) = @_;
$start_from-- if defined $start_from; $start_from-- if defined $start_from;
$start_from = 0 if not defined $start_from or $start_from < 0; $start_from = 0 if not defined $start_from or $start_from < 0;
my $result = ""; my $result = "";
if ($start_from > @{$undos->{list}}) { if ($start_from > @{$undos->{list}}) {
if (@{$undos->{list}} == 1) { return "But there is only one revision available."; } if (@{$undos->{list}} == 1) {
else { return "But there are only " . @{$undos->{list}} . " revisions available."; } return "But there is only one revision available.";
} else {
return "But there are only " . @{$undos->{list}} . " revisions available.";
}
} }
if ($start_from == 0) { if ($start_from == 0) {
if ($undos->{idx} == 0) { $result .= "*1*: "; } if ($undos->{idx} == 0) {
else { $result .= "1: "; } $result .= "*1*: ";
} else {
$result .= "1: ";
}
$result .= $self->hash_differences_as_string({}, $undos->{list}->[0]) . ";\n\n"; $result .= $self->hash_differences_as_string({}, $undos->{list}->[0]) . ";\n\n";
$start_from++; $start_from++;
} }
for (my $i = $start_from; $i < @{$undos->{list}}; $i++) { for (my $i = $start_from; $i < @{$undos->{list}}; $i++) {
if ($i == $undos->{idx}) { $result .= "*" . ($i + 1) . "*: "; } if ($i == $undos->{idx}) {
else { $result .= ($i + 1) . ": "; } $result .= "*" . ($i + 1) . "*: ";
} else {
$result .= ($i + 1) . ": ";
}
$result .= $self->hash_differences_as_string($undos->{list}->[$i - 1], $undos->{list}->[$i]); $result .= $self->hash_differences_as_string($undos->{list}->[$i - 1], $undos->{list}->[$i]);
$result .= ";\n\n"; $result .= ";\n\n";
} }

8
lib/PBot/Core/Commands/Func.pm
View File

@ -21,15 +21,11 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_func(@_) }, 'func', 0); $self->{pbot}->{commands}->register(sub { $self->cmd_func(@_) }, 'func', 0);
} }
sub cmd_func { sub cmd_func($self, $context) {
my ($self, $context) = @_;
my $func = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); my $func = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
if (not defined $func) { if (not defined $func) {

7
lib/PBot/Core/Commands/Help.pm
View File

@ -10,14 +10,11 @@ package PBot::Core::Commands::Help;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_help(@_) }, 'help'); $self->{pbot}->{commands}->register(sub { $self->cmd_help(@_) }, 'help');
} }
sub cmd_help { sub cmd_help($self, $context) {
my ($self, $context) = @_;
if (not length $context->{arguments}) { if (not length $context->{arguments}) {
return "For general help, see <https://github.com/pragma-/pbot/tree/master/doc#table-of-contents>. For help about a specific command or factoid, use `help <keyword> [channel]`."; return "For general help, see <https://github.com/pragma-/pbot/tree/master/doc#table-of-contents>. For help about a specific command or factoid, use `help <keyword> [channel]`.";
} }

12
lib/PBot/Core/Commands/IgnoreList.pm
View File

@ -12,9 +12,7 @@ use PBot::Imports;
use Time::Duration qw/concise duration/; use Time::Duration qw/concise duration/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_ignore(@_) }, "ignore", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_ignore(@_) }, "ignore", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unignore(@_) }, "unignore", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_unignore(@_) }, "unignore", 1);
@ -27,9 +25,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('chanop', 'can-unignore', 1); $self->{pbot}->{capabilities}->add('chanop', 'can-unignore', 1);
} }
sub cmd_ignore { sub cmd_ignore($self, $context) {
my ($self, $context) = @_;
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $target) { if (not defined $target) {
@ -82,9 +78,7 @@ sub cmd_ignore {
return $self->{pbot}->{ignorelist}->add($channel, $target, $length, $context->{hostmask}); return $self->{pbot}->{ignorelist}->add($channel, $target, $length, $context->{hostmask});
} }
sub cmd_unignore { sub cmd_unignore($self, $context) {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $target) { if (not defined $target) {

8
lib/PBot/Core/Commands/LagChecker.pm
View File

@ -13,15 +13,11 @@ use PBot::Imports;
use Time::Duration qw/concise ago/; use Time::Duration qw/concise ago/;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_lagcheck(@_) }, "lagcheck", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_lagcheck(@_) }, "lagcheck", 0);
} }
sub cmd_lagcheck { sub cmd_lagcheck($self, $context) {
my ($self, $context) = @_;
if (defined $self->{pbot}->{lagchecker}->{pong_received} and $self->{pbot}->{lagchecker}->{pong_received} == 0) { if (defined $self->{pbot}->{lagchecker}->{pong_received} and $self->{pbot}->{lagchecker}->{pong_received} == 0) {
# a ping has been sent (pong_received is not undef) and no pong has been received yet # a ping has been sent (pong_received is not undef) and no pong has been received yet
my $elapsed = tv_interval($self->{pbot}->{lagchecker}->{ping_send_time}); my $elapsed = tv_interval($self->{pbot}->{lagchecker}->{ping_send_time});

27
lib/PBot/Core/Commands/MessageHistory.pm
View File

@ -15,9 +15,7 @@ use PBot::Core::MessageHistory::Constants ':all';
use Time::HiRes qw(time tv_interval); use Time::HiRes qw(time tv_interval);
use Time::Duration; use Time::Duration;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# unprivileged commands # unprivileged commands
$self->{pbot}->{commands}->register(sub { $self->cmd_list_also_known_as(@_) }, "aka", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_list_also_known_as(@_) }, "aka", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_recall_message(@_) }, "recall", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_recall_message(@_) }, "recall", 0);
@ -34,9 +32,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-akadelete', 1); $self->{pbot}->{capabilities}->add('admin', 'can-akadelete', 1);
} }
sub cmd_list_also_known_as { sub cmd_list_also_known_as($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: aka [-hilngrw] <nick> [-sort <by>]; -h show hostmasks; -i show ids; -l show last seen, -n show nickserv accounts; -g show gecos, -r show relationships; -w include weak links"; my $usage = "Usage: aka [-hilngrw] <nick> [-sort <by>]; -h show hostmasks; -i show ids; -l show last seen, -n show nickserv accounts; -g show gecos, -r show relationships; -w include weak links";
if (not length $context->{arguments}) { if (not length $context->{arguments}) {
@ -199,9 +195,7 @@ sub cmd_list_also_known_as {
} }
} }
sub cmd_recall_message { sub cmd_recall_message($self, $context) {
my ($self, $context) = @_;
my $usage = 'Usage: recall [nick [history [channel]]] [-c <channel>] [-t <text>] [-b <context before>] [-a <context after>] [-x <filter to nick>] [-n <count>] [-r raw mode] [+ ...]'; my $usage = 'Usage: recall [nick [history [channel]]] [-c <channel>] [-t <text>] [-b <context before>] [-a <context after>] [-x <filter to nick>] [-n <count>] [-r raw mode] [+ ...]';
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
@ -468,14 +462,11 @@ sub cmd_recall_message {
return $result; return $result;
} }
sub cmd_rebuild_aliases { sub cmd_rebuild_aliases($self, $context) {
my ($self, $context) = @_;
$self->{pbot}->{messagehistory}->{database}->rebuild_aliases_table; $self->{pbot}->{messagehistory}->{database}->rebuild_aliases_table;
} }
sub cmd_aka_link { sub cmd_aka_link($self, $context) {
my ($self, $context) = @_;
my ($id, $alias, $type) = split /\s+/, $context->{arguments}; my ($id, $alias, $type) = split /\s+/, $context->{arguments};
$type = LINK_STRONG if not defined $type; $type = LINK_STRONG if not defined $type;
@ -502,9 +493,7 @@ sub cmd_aka_link {
} }
} }
sub cmd_aka_unlink { sub cmd_aka_unlink($self, $context) {
my ($self, $context) = @_;
my ($id, $alias) = split /\s+/, $context->{arguments}; my ($id, $alias) = split /\s+/, $context->{arguments};
if (not $id or not $alias) { if (not $id or not $alias) {
@ -529,9 +518,7 @@ sub cmd_aka_unlink {
} }
} }
sub cmd_aka_delete { sub cmd_aka_delete($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: akadelete [-hn] <account id or hostmask>; -h delete only hostmask; -n delete only nickserv"; my $usage = "Usage: akadelete [-hn] <account id or hostmask>; -h delete only hostmask; -n delete only nickserv";
if (not length $context->{arguments}) { if (not length $context->{arguments}) {

31
lib/PBot/Core/Commands/Misc.pm
View File

@ -13,9 +13,7 @@ use parent 'PBot::Core::Class';
use Time::Duration qw/duration/; use Time::Duration qw/duration/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# misc commands # misc commands
$self->{pbot}->{commands}->register(sub { $self->cmd_nop(@_) }, 'nop', 0); $self->{pbot}->{commands}->register(sub { $self->cmd_nop(@_) }, 'nop', 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_uptime(@_) }, 'uptime', 0); $self->{pbot}->{commands}->register(sub { $self->cmd_uptime(@_) }, 'uptime', 0);
@ -32,20 +30,16 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-in', 1); $self->{pbot}->{capabilities}->add('admin', 'can-in', 1);
} }
sub cmd_nop { sub cmd_nop($self, $context) {
my ($self, $context) = @_;
$self->{pbot}->{logger}->log("Disregarding NOP command.\n"); $self->{pbot}->{logger}->log("Disregarding NOP command.\n");
return ''; return '';
} }
sub cmd_uptime { sub cmd_uptime($self, $context) {
my ($self, $context) = @_;
return localtime($self->{pbot}->{startup_timestamp}) . ' [' . duration(time - $self->{pbot}->{startup_timestamp}) . ']'; return localtime($self->{pbot}->{startup_timestamp}) . ' [' . duration(time - $self->{pbot}->{startup_timestamp}) . ']';
} }
sub cmd_in_channel { sub cmd_in_channel($self, $context) {
my ($self, $context) = @_;
my $usage = 'Usage: in <channel> <command>'; my $usage = 'Usage: in <channel> <command>';
if (not length $context->{arguments}) { if (not length $context->{arguments}) {
@ -71,8 +65,7 @@ sub cmd_in_channel {
return $self->{pbot}->{interpreter}->interpret($context); return $self->{pbot}->{interpreter}->interpret($context);
} }
sub cmd_list { sub cmd_list($self, $context) {
my ($self, $context) = @_;
my $text; my $text;
my $usage = 'Usage: list <applets|commands>'; my $usage = 'Usage: list <applets|commands>';
@ -110,15 +103,13 @@ sub cmd_list {
return $usage; return $usage;
} }
sub cmd_sl { sub cmd_sl($self, $context) {
my ($self, $context) = @_;
return "Usage: sl <ircd command>" if not length $context->{arguments}; return "Usage: sl <ircd command>" if not length $context->{arguments};
$self->{pbot}->{conn}->sl($context->{arguments}); $self->{pbot}->{conn}->sl($context->{arguments});
return "/msg $context->{nick} sl: command sent. See log for result."; return "/msg $context->{nick} sl: command sent. See log for result.";
} }
sub cmd_die { sub cmd_die($self, $context) {
my ($self, $context) = @_;
$self->{pbot}->{logger}->log("$context->{hostmask} made me exit.\n"); $self->{pbot}->{logger}->log("$context->{hostmask} made me exit.\n");
$self->{pbot}->{conn}->privmsg($context->{from}, "Good-bye.") if $context->{from} ne 'stdin@pbot'; $self->{pbot}->{conn}->privmsg($context->{from}, "Good-bye.") if $context->{from} ne 'stdin@pbot';
$self->{pbot}->{conn}->quit("Departure requested.") if defined $self->{pbot}->{conn}; $self->{pbot}->{conn}->quit("Departure requested.") if defined $self->{pbot}->{conn};
@ -126,9 +117,7 @@ sub cmd_die {
exit 0; exit 0;
} }
sub cmd_export { sub cmd_export($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: export factoids"; my $usage = "Usage: export factoids";
return $usage if not length $context->{arguments}; return $usage if not length $context->{arguments};
@ -140,9 +129,7 @@ sub cmd_export {
return $usage; return $usage;
} }
sub cmd_eval { sub cmd_eval($self, $context) {
my ($self, $context) = @_;
$self->{pbot}->{logger}->log("eval: $context->{from} $context->{hostmask} evaluating `$context->{arguments}`\n"); $self->{pbot}->{logger}->log("eval: $context->{from} $context->{hostmask} evaluating `$context->{arguments}`\n");
my $ret = ''; my $ret = '';

7
lib/PBot/Core/Commands/NickList.pm
View File

@ -13,14 +13,11 @@ use parent 'PBot::Core::Class';
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/concise ago/; use Time::Duration qw/concise ago/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_nicklist(@_) }, "nicklist", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_nicklist(@_) }, "nicklist", 1);
} }
sub cmd_nicklist { sub cmd_nicklist($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: nicklist (<channel [nick]> | <nick>) [-sort <by>] [-hostmask] [-join]; -hostmask shows hostmasks instead of nicks; -join includes join time"; my $usage = "Usage: nicklist (<channel [nick]> | <nick>) [-sort <by>] [-hostmask] [-join]; -hostmask shows hostmasks instead of nicks; -join includes join time";
my $sort_method = 'nick'; my $sort_method = 'nick';

20
lib/PBot/Core/Commands/Plugins.pm
View File

@ -12,9 +12,7 @@ use parent 'PBot::Core::Class';
use File::Basename; use File::Basename;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# plugin management bot commands # plugin management bot commands
$self->{pbot}->{commands}->register(sub { $self->cmd_plug(@_) }, "plug", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_plug(@_) }, "plug", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unplug(@_) }, "unplug", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_unplug(@_) }, "unplug", 1);
@ -22,9 +20,7 @@ sub initialize {
$self->{pbot}->{commands}->register(sub { $self->cmd_pluglist(@_) }, "pluglist", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_pluglist(@_) }, "pluglist", 0);
} }
sub cmd_plug { sub cmd_plug($self, $context) {
my ($self, $context) = @_;
my $plugin = $context->{arguments}; my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: plug <plugin>"; } if (not length $plugin) { return "Usage: plug <plugin>"; }
@ -36,9 +32,7 @@ sub cmd_plug {
} }
} }
sub cmd_unplug { sub cmd_unplug($self, $context) {
my ($self, $context) = @_;
my $plugin = $context->{arguments}; my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: unplug <plugin>"; } if (not length $plugin) { return "Usage: unplug <plugin>"; }
@ -50,9 +44,7 @@ sub cmd_unplug {
} }
} }
sub cmd_replug { sub cmd_replug($self, $context) {
my ($self, $context) = @_;
my $plugin = $context->{arguments}; my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: replug <plugin>"; } if (not length $plugin) { return "Usage: replug <plugin>"; }
@ -66,9 +58,7 @@ sub cmd_replug {
return $result; return $result;
} }
sub cmd_pluglist { sub cmd_pluglist($self, $context) {
my ($self, $context) = @_;
my @plugins = sort keys %{$self->{pbot}->{plugins}->{plugins}}; my @plugins = sort keys %{$self->{pbot}->{plugins}->{plugins}};
return "No plugins loaded." if not @plugins; return "No plugins loaded." if not @plugins;

12
lib/PBot/Core/Commands/ProcessManager.pm
View File

@ -13,9 +13,7 @@ use parent 'PBot::Core::Class';
use Time::Duration qw/concise duration/; use Time::Duration qw/concise duration/;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# process manager bot commands # process manager bot commands
$self->{pbot}->{commands}->register(sub { $self->cmd_ps(@_) }, 'ps', 0); $self->{pbot}->{commands}->register(sub { $self->cmd_ps(@_) }, 'ps', 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_kill(@_) }, 'kill', 1); $self->{pbot}->{commands}->register(sub { $self->cmd_kill(@_) }, 'kill', 1);
@ -24,9 +22,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-kill', 1); $self->{pbot}->{capabilities}->add('admin', 'can-kill', 1);
} }
sub cmd_ps { sub cmd_ps($self, $context) {
my ($self, $context) = @_;
my $usage = 'Usage: ps [-atu]; -a show all information; -t show running time; -u show user/channel'; my $usage = 'Usage: ps [-atu]; -a show all information; -t show running time; -u show user/channel';
my ($show_all, $show_user, $show_running_time); my ($show_all, $show_user, $show_running_time);
@ -82,9 +78,7 @@ sub cmd_ps {
return $result; return $result;
} }
sub cmd_kill { sub cmd_kill($self, $context) {
my ($self, $context) = @_;
my $usage = 'Usage: kill [-a] [-t <seconds>] [-s <signal>] [pids...]; -a kill all processes; -t <seconds> kill processes running longer than <seconds>; -s send <signal> to processes'; my $usage = 'Usage: kill [-a] [-t <seconds>] [-s <signal>] [pids...]; -a kill all processes; -t <seconds> kill processes running longer than <seconds>; -s send <signal> to processes';
my ($kill_all, $kill_time, $signal); my ($kill_all, $kill_time, $signal);

8
lib/PBot/Core/Commands/Refresher.pm
View File

@ -12,15 +12,11 @@ use parent 'PBot::Core::Class';
use File::Basename; use File::Basename;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_refresh(@_) }, "refresh", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_refresh(@_) }, "refresh", 1);
} }
sub cmd_refresh { sub cmd_refresh($self, $context) {
my ($self, $context) = @_;
my $last_update = $self->{pbot}->{updater}->get_last_update_version; my $last_update = $self->{pbot}->{updater}->get_last_update_version;
my @updates = $self->{pbot}->{updater}->get_available_updates($last_update); my @updates = $self->{pbot}->{updater}->get_available_updates($last_update);

31
lib/PBot/Core/Commands/Registry.pm
View File

@ -10,8 +10,7 @@ package PBot::Core::Commands::Registry;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_regset(@_) }, "regset", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regset(@_) }, "regset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_regunset(@_) }, "regunset", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regunset(@_) }, "regunset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_regshow(@_) }, "regshow", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_regshow(@_) }, "regshow", 0);
@ -21,9 +20,7 @@ sub initialize {
$self->{pbot}->{commands}->register(sub { $self->cmd_regfind(@_) }, "regfind", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_regfind(@_) }, "regfind", 0);
} }
sub cmd_regset { sub cmd_regset($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: regset <section>.<item> [value]"; my $usage = "Usage: regset <section>.<item> [value]";
# support "<section>.<key>" syntax in addition to "<section> <key>" # support "<section>.<key>" syntax in addition to "<section> <key>"
@ -52,9 +49,7 @@ sub cmd_regset {
return "$section.$item set to $value"; return "$section.$item set to $value";
} }
sub cmd_regunset { sub cmd_regunset($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: regunset <section>.<item>"; my $usage = "Usage: regunset <section>.<item>";
# support "<section>.<key>" syntax in addition to "<section> <key>" # support "<section>.<key>" syntax in addition to "<section> <key>"
@ -86,9 +81,7 @@ sub cmd_regunset {
return "$section.$item deleted from registry"; return "$section.$item deleted from registry";
} }
sub cmd_regsetmeta { sub cmd_regsetmeta($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: regsetmeta <section>.<item> [key [value]]"; my $usage = "Usage: regsetmeta <section>.<item> [key [value]]";
# support "<section>.<key>" syntax in addition to "<section> <key>" # support "<section>.<key>" syntax in addition to "<section> <key>"
@ -112,9 +105,7 @@ sub cmd_regsetmeta {
return $self->{pbot}->{registry}->set($section, $item, $key, $value); return $self->{pbot}->{registry}->set($section, $item, $key, $value);
} }
sub cmd_regunsetmeta { sub cmd_regunsetmeta($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: regunsetmeta <section>.<item> <key>"; my $usage = "Usage: regunsetmeta <section>.<item> <key>";
# support "<section>.<key>" syntax in addition to "<section> <key>" # support "<section>.<key>" syntax in addition to "<section> <key>"
@ -135,9 +126,7 @@ sub cmd_regunsetmeta {
return $self->{pbot}->{registry}->unset($section, $item, $key); return $self->{pbot}->{registry}->unset($section, $item, $key);
} }
sub cmd_regshow { sub cmd_regshow($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: regshow <section>.<item>"; my $usage = "Usage: regshow <section>.<item>";
my $registry = $self->{pbot}->{registry}->{storage}; my $registry = $self->{pbot}->{registry}->{storage};
@ -176,9 +165,7 @@ sub cmd_regshow {
return $result; return $result;
} }
sub cmd_regfind { sub cmd_regfind($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: regfind [-showvalues] [-section section] <regex>"; my $usage = "Usage: regfind [-showvalues] [-section section] <regex>";
my $registry = $self->{pbot}->{registry}->{storage}; my $registry = $self->{pbot}->{registry}->{storage};
@ -262,9 +249,7 @@ sub cmd_regfind {
} }
} }
sub cmd_regchange { sub cmd_regchange($self, $context) {
my ($self, $context) = @_;
my ($section, $item, $delim, $tochange, $changeto, $modifier); my ($section, $item, $delim, $tochange, $changeto, $modifier);
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};

8
lib/PBot/Core/Commands/Reload.pm
View File

@ -10,15 +10,11 @@ package PBot::Core::Commands::Reload;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_reload(@_) }, 'reload', 1); $self->{pbot}->{commands}->register(sub { $self->cmd_reload(@_) }, 'reload', 1);
} }
sub cmd_reload { sub cmd_reload($self, $context) {
my ($self, $context) = @_;
my %reloadables = ( my %reloadables = (
'capabilities' => sub { 'capabilities' => sub {
$self->{pbot}->{capabilities}->{caps}->load; $self->{pbot}->{capabilities}->{caps}->load;

40
lib/PBot/Core/Commands/Users.pm
View File

@ -10,9 +10,7 @@ package PBot::Core::Commands::Users;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register commands # register commands
$self->{pbot}->{commands}->register(sub { $self->cmd_login(@_) }, "login", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_login(@_) }, "login", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_logout(@_) }, "logout", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_logout(@_) }, "logout", 0);
@ -35,9 +33,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('can-modify-admins', undef, 1); $self->{pbot}->{capabilities}->add('can-modify-admins', undef, 1);
} }
sub cmd_login { sub cmd_login($self, $context) {
my ($self, $context) = @_;
my $channel = $context->{from}; my $channel = $context->{from};
return "Usage: login [channel] password" if not $context->{arguments}; return "Usage: login [channel] password" if not $context->{arguments};
@ -64,8 +60,7 @@ sub cmd_login {
return "/msg $context->{nick} $result"; return "/msg $context->{nick} $result";
} }
sub cmd_logout { sub cmd_logout($self, $context) {
my ($self, $context) = @_;
$context->{from} = $context->{arguments} if length $context->{arguments}; $context->{from} = $context->{arguments} if length $context->{arguments};
my ($user_channel, $user_hostmask) = $self->{pbot}->{users}->find_user_account($context->{from}, $context->{hostmask}); my ($user_channel, $user_hostmask) = $self->{pbot}->{users}->find_user_account($context->{from}, $context->{hostmask});
return "/msg $context->{nick} You do not have a user account. You may use the `my` command to create a personal user account. See `help my`." if not defined $user_channel; return "/msg $context->{nick} You do not have a user account. You may use the `my` command to create a personal user account. See `help my`." if not defined $user_channel;
@ -80,8 +75,7 @@ sub cmd_logout {
return "/msg $context->{nick} Logged out of " . $self->{pbot}->{users}->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text."; return "/msg $context->{nick} Logged out of " . $self->{pbot}->{users}->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text.";
} }
sub cmd_users { sub cmd_users($self, $context) {
my ($self, $context) = @_;
my $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); my $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
my $include_global = ''; my $include_global = '';
@ -132,8 +126,7 @@ sub cmd_users {
return $text; return $text;
} }
sub cmd_useradd { sub cmd_useradd($self, $context) {
my ($self, $context) = @_;
my ($name, $hostmasks, $channels, $capabilities, $password) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5); my ($name, $hostmasks, $channels, $capabilities, $password) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5);
$capabilities //= 'none'; $capabilities //= 'none';
@ -170,9 +163,7 @@ sub cmd_useradd {
return "User added."; return "User added.";
} }
sub cmd_userdel { sub cmd_userdel($self, $context) {
my ($self, $context) = @_;
if (not length $context->{arguments}) { return "Usage: userdel <username>"; } if (not length $context->{arguments}) { return "Usage: userdel <username>"; }
my $u = $self->{pbot}->{users}->find_user($context->{from}, $context->{hostmask}); my $u = $self->{pbot}->{users}->find_user($context->{from}, $context->{hostmask});
@ -189,9 +180,7 @@ sub cmd_userdel {
return $self->{pbot}->{users}->remove_user($context->{arguments}); return $self->{pbot}->{users}->remove_user($context->{arguments});
} }
sub cmd_usershow { sub cmd_usershow($self, $context) {
my ($self, $context) = @_;
my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $name) { return "Usage: usershow <username> [key]"; } if (not defined $name) { return "Usage: usershow <username> [key]"; }
@ -213,9 +202,7 @@ sub cmd_usershow {
return $result; return $result;
} }
sub cmd_userset { sub cmd_userset($self, $context) {
my ($self, $context) = @_;
my ($name, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); my ($name, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $name) { return "Usage: userset <username> [key [value]]"; } if (not defined $name) { return "Usage: userset <username> [key [value]]"; }
@ -260,9 +247,7 @@ sub cmd_userset {
return $result; return $result;
} }
sub cmd_userunset { sub cmd_userunset($self, $context) {
my ($self, $context) = @_;
my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $name or not defined $key) { return "Usage: userunset <username> <key>"; } if (not defined $name or not defined $key) { return "Usage: userunset <username> <key>"; }
@ -305,8 +290,7 @@ sub cmd_userunset {
return $self->{pbot}->{users}->{storage}->unset($name, $key); return $self->{pbot}->{users}->{storage}->unset($name, $key);
} }
sub cmd_my { sub cmd_my($self, $context) {
my ($self, $context) = @_;
my ($key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); my ($key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (defined $value) { if (defined $value) {
@ -372,9 +356,7 @@ sub cmd_my {
return $result; return $result;
} }
sub cmd_id { sub cmd_id($self, $context) {
my ($self, $context) = @_;
my $target = length $context->{arguments} ? $context->{arguments} : $context->{nick}; my $target = length $context->{arguments} ? $context->{arguments} : $context->{nick};
my ($message_account, $hostmask); my ($message_account, $hostmask);

8
lib/PBot/Core/Commands/Version.pm
View File

@ -13,9 +13,7 @@ use PBot::Imports;
use LWP::UserAgent; use LWP::UserAgent;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register `version` command # register `version` command
$self->{pbot}->{commands}->register(sub { $self->cmd_version(@_) }, 'version'); $self->{pbot}->{commands}->register(sub { $self->cmd_version(@_) }, 'version');
@ -27,9 +25,7 @@ sub initialize {
}; };
} }
sub cmd_version { sub cmd_version($self, $context) {
my ($self, $context) = @_;
my $ratelimit = $self->{pbot}->{registry}->get_value('version', 'check_limit') // 300; my $ratelimit = $self->{pbot}->{registry}->get_value('version', 'check_limit') // 300;
if (time - $self->{last_check}->{timestamp} >= $ratelimit) { if (time - $self->{last_check}->{timestamp} >= $ratelimit) {

18
lib/PBot/Core/EventDispatcher.pm
View File

@ -14,9 +14,7 @@ use PBot::Imports;
use PBot::Core::Utils::PriorityQueue; use PBot::Core::Utils::PriorityQueue;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# hash table of event handlers # hash table of event handlers
$self->{handlers} = {}; $self->{handlers} = {};
} }
@ -31,9 +29,7 @@ sub initialize {
# before any handlers need to consult its list, or depopulated by PARTs, QUITs, # before any handlers need to consult its list, or depopulated by PARTs, QUITs,
# KICKs, etc, after any other handlers need to consult its list. # KICKs, etc, after any other handlers need to consult its list.
sub register_handler { sub register_handler($self, $name, $subref, $priority = 50) {
my ($self, $name, $subref, $priority) = @_;
# get the package of the calling subroutine # get the package of the calling subroutine
my ($package) = caller(0); my ($package) = caller(0);
@ -41,7 +37,7 @@ sub register_handler {
my $handler_id = "$package-$name"; my $handler_id = "$package-$name";
my $entry = { my $entry = {
priority => $priority // 50, priority => $priority,
id => $handler_id, id => $handler_id,
subref => $subref, subref => $subref,
}; };
@ -61,9 +57,7 @@ sub register_handler {
} }
# remove an event handler # remove an event handler
sub remove_handler { sub remove_handler($self, $name) {
my ($self, $name) = @_;
# get the package of the calling subroutine # get the package of the calling subroutine
my ($package) = caller(0); my ($package) = caller(0);
@ -95,9 +89,7 @@ sub remove_handler {
} }
# send an event to its handlers # send an event to its handlers
sub dispatch_event { sub dispatch_event($self, $name, $data = undef) {
my ($self, $name, $data) = @_;
# debugging flag # debugging flag
my $debug = $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug') // 0; my $debug = $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug') // 0;

65
lib/PBot/Core/EventQueue.pm
View File

@ -5,7 +5,7 @@
# #
# Note: PBot::Core::EventQueue has no relation to PBot::Core::EventDispatcher. # Note: PBot::Core::EventQueue has no relation to PBot::Core::EventDispatcher.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
package PBot::Core::EventQueue; package PBot::Core::EventQueue;
@ -17,22 +17,18 @@ use PBot::Core::Utils::PriorityQueue;
use Time::HiRes qw/time/; use Time::HiRes qw/time/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{event_queue} = PBot::Core::Utils::PriorityQueue->new(pbot => $self->{pbot}); $self->{event_queue} = PBot::Core::Utils::PriorityQueue->new(pbot => $self->{pbot});
} }
# returns seconds until upcoming event. # returns seconds until upcoming event.
sub duration_until_next_event { sub duration_until_next_event($self) {
my ($self) = @_;
return 0 if not $self->{event_queue}->count; return 0 if not $self->{event_queue}->count;
return $self->{event_queue}->get_priority(0) - time; return $self->{event_queue}->get_priority(0) - time;
} }
# invokes any current events and then returns seconds until upcoming event. # invokes any current events and then returns seconds until upcoming event.
sub do_events { sub do_events($self) {
my ($self) = @_;
# early-return if no events available # early-return if no events available
return 0 if not $self->{event_queue}->count; return 0 if not $self->{event_queue}->count;
@ -77,20 +73,12 @@ sub do_events {
} }
# check if an event is in the event queue. # check if an event is in the event queue.
sub exists { sub exists($self, $id) {
my ($self, $id) = @_;
return scalar grep { $_->{id} eq $id } $self->{event_queue}->entries; return scalar grep { $_->{id} eq $id } $self->{event_queue}->entries;
} }
# adds an event to the event queue, optionally repeating # adds an event to the event queue, optionally repeating
sub enqueue_event { sub enqueue_event($self, $subref, $interval = 0, $id = "unamed (${interval}s $subref)", $repeating = 0) {
my ($self, $subref, $interval, $id, $repeating) = @_;
# default values
$id //= "unnamed (${interval}s $subref)";
$repeating //= 0;
$interval //= 0;
# create event structure # create event structure
my $event = { my $event = {
id => $id, id => $id,
@ -111,16 +99,13 @@ sub enqueue_event {
} }
# convenient alias to add an event with repeating defaulted to enabled. # convenient alias to add an event with repeating defaulted to enabled.
sub enqueue { sub enqueue($self, $subref, $interval = undef, $id = undef, $repeating = 1) {
my ($self, $subref, $interval, $id, $repeating) = @_; $self->enqueue_event($subref, $interval, $id, $repeating);
$self->enqueue_event($subref, $interval, $id, $repeating // 1);
} }
# removes an event from the event queue, optionally invoking it. # removes an event from the event queue, optionally invoking it.
# `id` can contain `.*` and `.*?` for wildcard-matching/globbing. # `id` can contain `.*` and `.*?` for wildcard-matching/globbing.
sub dequeue_event { sub dequeue_event($self, $id, $execute = 0) {
my ($self, $id, $execute) = @_;
my $result = eval { my $result = eval {
# escape special characters # escape special characters
$id = quotemeta $id; $id = quotemeta $id;
@ -172,23 +157,19 @@ sub dequeue_event {
} }
# alias to dequeue_event, for consistency. # alias to dequeue_event, for consistency.
sub dequeue { sub dequeue($self, $id) {
my ($self, $id) = @_;
$self->dequeue_event($id); $self->dequeue_event($id);
} }
# invoke and remove all events matching `id`, which can # invoke and remove all events matching `id`, which can
# contain `.*` and `.*?` for wildcard-matching/globbing. # contain `.*` and `.*?` for wildcard-matching/globbing.
sub execute_and_dequeue_event { sub execute_and_dequeue_event($self, $id) {
my ($self, $id) = @_;
return $self->dequeue_event($id, 1); return $self->dequeue_event($id, 1);
} }
# replace code subrefs for matching events. if no events # replace code subrefs for matching events. if no events
# were found, then add the event to the event queue. # were found, then add the event to the event queue.
sub replace_subref_or_enqueue_event { sub replace_subref_or_enqueue_event($self, $subref, $interval, $id, $repeating = 0) {
my ($self, $subref, $interval, $id, $repeating) = @_;
# find events matching id # find events matching id
my @events = grep { $_->{id} eq $id } $self->{event_queue}->entries; my @events = grep { $_->{id} eq $id } $self->{event_queue}->entries;
@ -205,9 +186,7 @@ sub replace_subref_or_enqueue_event {
} }
# remove existing events of this id then enqueue new event. # remove existing events of this id then enqueue new event.
sub replace_or_enqueue_event { sub replace_or_enqueue_event($self, $subref, $interval, $id, $repeating = 0) {
my ($self, $subref, $interval, $id, $repeating) = @_;
# remove event if it exists # remove event if it exists
$self->dequeue_event($id) if $self->exists($id); $self->dequeue_event($id) if $self->exists($id);
@ -216,9 +195,7 @@ sub replace_or_enqueue_event {
} }
# add event unless it already had been added. # add event unless it already had been added.
sub enqueue_event_unless_exists { sub enqueue_event_unless_exists($self, $subref, $interval, $id, $repeating = 0) {
my ($self, $subref, $interval, $id, $repeating) = @_;
# event already exists, bail out # event already exists, bail out
return if $self->exists($id); return if $self->exists($id);
@ -227,9 +204,7 @@ sub enqueue_event_unless_exists {
} }
# update the `repeating` flag for all events matching `id`. # update the `repeating` flag for all events matching `id`.
sub update_repeating { sub update_repeating($self, $id, $repeating) {
my ($self, $id, $repeating) = @_;
foreach my $event ($self->{event_queue}->entries) { foreach my $event ($self->{event_queue}->entries) {
if ($event->{id} eq $id) { if ($event->{id} eq $id) {
$event->{repeating} = $repeating; $event->{repeating} = $repeating;
@ -238,9 +213,7 @@ sub update_repeating {
} }
# update the `interval` value for all events matching `id`. # update the `interval` value for all events matching `id`.
sub update_interval { sub update_interval($self, $id, $interval, $dont_enqueue = 0) {
my ($self, $id, $interval, $dont_enqueue) = @_;
for (my $i = 0; $i < $self->{event_queue}->count; $i++) { for (my $i = 0; $i < $self->{event_queue}->count; $i++) {
my $event = $self->{event_queue}->get($i); my $event = $self->{event_queue}->get($i);
@ -258,13 +231,11 @@ sub update_interval {
} }
} }
sub count { sub count($self) {
my ($self) = @_;
return $self->{event_queue}->count; return $self->{event_queue}->count;
} }
sub entries { sub entries($self) {
my ($self) = @_;
return $self->{event_queue}->entries; return $self->{event_queue}->entries;
} }

4
lib/PBot/Core/Factoids.pm
View File

@ -19,9 +19,7 @@ use PBot::Core::Factoids::Modifiers;
use PBot::Core::Factoids::Selectors; use PBot::Core::Factoids::Selectors;
use PBot::Core::Factoids::Variables; use PBot::Core::Factoids::Variables;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{data} = PBot::Core::Factoids::Data->new(%conf); $self->{data} = PBot::Core::Factoids::Data->new(%conf);
$self->{data}->load; $self->{data}->load;

4
lib/PBot/Core/Factoids/Code.pm
View File

@ -15,9 +15,7 @@ use JSON;
sub initialize {} sub initialize {}
sub execute { sub execute($self, $context) {
my ($self, $context) = @_;
my $factoids = $self->{pbot}->{factoids}->{data}->{storage}; my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my $interpolate = $factoids->get_data($context->{channel}, $context->{keyword}, 'interpolate'); my $interpolate = $factoids->get_data($context->{channel}, $context->{keyword}, 'interpolate');

24
lib/PBot/Core/Factoids/Data.pm
View File

@ -52,9 +52,7 @@ our %factoid_metadata = (
'workdir' => 'TEXT', 'workdir' => 'TEXT',
); );
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{storage} = PBot::Core::Storage::DualIndexSQLiteObject->new( $self->{storage} = PBot::Core::Storage::DualIndexSQLiteObject->new(
pbot => $self->{pbot}, pbot => $self->{pbot},
name => 'Factoids', name => 'Factoids',
@ -62,21 +60,17 @@ sub initialize {
); );
} }
sub load { sub load($self) {
my ($self) = @_;
$self->{storage}->load; $self->{storage}->load;
$self->{storage}->create_metadata(\%factoid_metadata); $self->{storage}->create_metadata(\%factoid_metadata);
} }
sub save { sub save($self, $export = 0) {
my ($self, $export) = @_;
$self->{storage}->save; $self->{storage}->save;
$self->{pbot}->{factoids}->{exporter}->export if $export; $self->{pbot}->{factoids}->{exporter}->export if $export;
} }
sub add { sub add($self, $type, $channel, $owner, $trigger, $action, $dont_save = 0) {
my ($self, $type, $channel, $owner, $trigger, $action, $dont_save) = @_;
$type = lc $type; $type = lc $type;
$channel = '.*' if $channel !~ /^#/; $channel = '.*' if $channel !~ /^#/;
@ -104,21 +98,17 @@ sub add {
$self->{storage}->add($channel, $trigger, $data, $dont_save); $self->{storage}->add($channel, $trigger, $data, $dont_save);
} }
sub remove { sub remove($self) {
my $self = shift;
my ($channel, $trigger) = @_; my ($channel, $trigger) = @_;
$channel = '.*' if $channel !~ /^#/; $channel = '.*' if $channel !~ /^#/;
return $self->{storage}->remove($channel, $trigger); return $self->{storage}->remove($channel, $trigger);
} }
sub get_meta { sub get_meta($self, $channel, $trigger = undef, $key = undef) {
my ($self, $channel, $trigger, $key) = @_;
return $self->{storage}->get_data($channel, $trigger, $key); return $self->{storage}->get_data($channel, $trigger, $key);
} }
sub find { sub find($self, $from, $keyword, %opts) {
my ($self, $from, $keyword, %opts) = @_;
my %default_opts = ( my %default_opts = (
arguments => '', arguments => '',
exact_channel => 0, exact_channel => 0,

4
lib/PBot/Core/Factoids/Exporter.pm
View File

@ -16,9 +16,7 @@ use POSIX qw(strftime);
sub initialize { sub initialize {
} }
sub export { sub export($self) {
my $self = shift;
my $filename; my $filename;
if (@_) { if (@_) {

8
lib/PBot/Core/Factoids/Interpreter.pm
View File

@ -16,9 +16,7 @@ use Time::Duration qw(duration);
sub initialize {} sub initialize {}
# main entry point for PBot::Core::Interpreter to interpret a factoid command # main entry point for PBot::Core::Interpreter to interpret a factoid command
sub interpreter { sub interpreter($self, $context) {
my ($self, $context) = @_;
# trace context and context's contents # trace context and context's contents
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper; use Data::Dumper;
@ -275,9 +273,7 @@ sub interpreter {
} }
} }
sub handle_action { sub handle_action($self, $context, $action) {
my ($self, $context, $action) = @_;
# trace context and context's contents # trace context and context's contents
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper; use Data::Dumper;

4
lib/PBot/Core/Factoids/Modifiers.pm
View File

@ -13,9 +13,7 @@ use PBot::Imports;
sub initialize { sub initialize {
} }
sub parse { sub parse($self, $modifier) {
my ($self, $modifier) = @_;
my %modifiers; my %modifiers;
my $interp = $self->{pbot}->{interpreter}; my $interp = $self->{pbot}->{interpreter};

19
lib/PBot/Core/Factoids/Selectors.pm
View File

@ -15,12 +15,9 @@ use PBot::Core::Utils::Indefinite;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
use Time::Duration qw(duration); use Time::Duration qw(duration);
sub initialize { sub initialize {}
}
sub make_list {
my ($self, $context, $extracted, $settings, %opts) = @_;
sub make_list($self, $context, $extracted, $settings, %opts) {
if ($extracted =~ /(.*?)(?<!\\)%\s*\(.*\)/) { if ($extracted =~ /(.*?)(?<!\\)%\s*\(.*\)/) {
$opts{nested}++; $opts{nested}++;
$extracted = $self->expand_selectors($context, $extracted, %opts); $extracted = $self->expand_selectors($context, $extracted, %opts);
@ -73,9 +70,7 @@ sub make_list {
return \@list; return \@list;
} }
sub select_weighted_item_from_list { sub select_weighted_item_from_list($self, $list, $index = undef) {
my ($self, $list, $index) = @_;
my @weights; my @weights;
my $weight_sum = 0; my $weight_sum = 0;
@ -105,9 +100,7 @@ sub select_weighted_item_from_list {
} }
} }
sub select_item { sub select_item($self, $context, $extracted, $modifiers, %opts) {
my ($self, $context, $extracted, $modifiers, %opts) = @_;
my %settings = $self->{pbot}->{factoids}->{modifiers}->parse($modifiers); my %settings = $self->{pbot}->{factoids}->{modifiers}->parse($modifiers);
if (exists $settings{errors}) { if (exists $settings{errors}) {
@ -195,9 +188,7 @@ sub select_item {
return $item; return $item;
} }
sub expand_selectors { sub expand_selectors($self, $context, $action, %opts) {
my ($self, $context, $action, %opts) = @_;
my %default_opts = ( my %default_opts = (
nested => 0, nested => 0,
recursions => 0, recursions => 0,

15
lib/PBot/Core/Factoids/Variables.pm
View File

@ -17,9 +17,7 @@ use JSON;
sub initialize {} sub initialize {}
sub expand_factoid_vars { sub expand_factoid_vars($self, $context, $action, %opts) {
my ($self, $context, $action, %opts) = @_;
my %default_opts = ( my %default_opts = (
nested => 0, nested => 0,
recursions => 0, recursions => 0,
@ -206,9 +204,7 @@ sub expand_factoid_vars {
return validate_string($result, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length')); return validate_string($result, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length'));
} }
sub expand_action_arguments { sub expand_action_arguments($self, $action, $input, $nick) {
my ($self, $action, $input, $nick) = @_;
$action = validate_string($action, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length')); $action = validate_string($action, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length'));
$input = validate_string($input, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length')); $input = validate_string($input, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length'));
@ -309,8 +305,7 @@ sub expand_action_arguments {
return $action; return $action;
} }
sub escape_json { sub escape_json($self, $text) {
my ($self, $text) = @_;
my $thing = {thing => $text}; my $thing = {thing => $text};
my $json = to_json $thing; my $json = to_json $thing;
$json =~ s/^{".*":"//; $json =~ s/^{".*":"//;
@ -318,9 +313,7 @@ sub escape_json {
return $json; return $json;
} }
sub expand_special_vars { sub expand_special_vars($self, $from, $nick, $root_keyword, $action) {
my ($self, $from, $nick, $root_keyword, $action) = @_;
$action =~ s/(?<!\\)\$nick:json|(?<!\\)\$\{nick:json\}/$self->escape_json($nick)/ge; $action =~ s/(?<!\\)\$nick:json|(?<!\\)\$\{nick:json\}/$self->escape_json($nick)/ge;
$action =~ s/(?<!\\)\$channel:json|(?<!\\)\$\{channel:json\}/$self->escape_json($from)/ge; $action =~ s/(?<!\\)\$channel:json|(?<!\\)\$\{channel:json\}/$self->escape_json($from)/ge;
$action =~ $action =~

20
lib/PBot/Core/Functions.pm
View File

@ -23,9 +23,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register `list` and `help` functions used to list # register `list` and `help` functions used to list
# functions and obtain help about them # functions and obtain help about them
@ -48,21 +46,15 @@ sub initialize {
); );
} }
sub register { sub register($self, $func, $data) {
my ($self, $func, $data) = @_;
$self->{funcs}->{$func} = $data; $self->{funcs}->{$func} = $data;
} }
sub unregister { sub unregister($self, $func) {
my ($self, $func) = @_;
delete $self->{funcs}->{$func}; delete $self->{funcs}->{$func};
} }
sub func_list { sub func_list($self, $regex = '.*') {
my ($self, $regex) = @_;
$regex //= '.*';
my $result = eval { my $result = eval {
my @funcs; my @funcs;
@ -94,9 +86,7 @@ sub func_list {
return $result; return $result;
} }
sub func_help { sub func_help($self, $func) {
my ($self, $func) = @_;
if (not length $func) { if (not length $func) {
return "func: invoke built-in functions; usage: func <keyword> [arguments]; to list available functions: func list [regex]"; return "func: invoke built-in functions; usage: func <keyword> [arguments]; to list available functions: func list [regex]";
} }

6
lib/PBot/Core/Handlers.pm
View File

@ -11,13 +11,11 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
use PBot::Core::Utils::LoadModules qw/load_modules/; use PBot::Core::Utils::LoadModules qw/load_modules/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->load_handlers(%conf); $self->load_handlers(%conf);
} }
sub load_handlers { sub load_handlers($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{logger}->log("Loading handlers:\n"); $self->{pbot}->{logger}->log("Loading handlers:\n");
load_modules($self, 'PBot::Core::Handlers'); load_modules($self, 'PBot::Core::Handlers');
} }

25
lib/PBot/Core/Handlers/BanList.pm
View File

@ -14,8 +14,7 @@ use PBot::Imports;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
use Time::Duration; use Time::Duration;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.endofnames', sub { $self->on_endofnames(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.endofnames', sub { $self->on_endofnames(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.banlist', sub { $self->on_banlist_entry(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.banlist', sub { $self->on_banlist_entry(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.quietlist', sub { $self->on_quietlist_entry(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.quietlist', sub { $self->on_quietlist_entry(@_) });
@ -27,9 +26,7 @@ sub initialize {
} }
# typically, immediately after joining a channel... # typically, immediately after joining a channel...
sub on_endofnames { sub on_endofnames($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{args}[1]; my $channel = lc $event->{args}[1];
$self->{pbot}->{logger}->log("Retrieving banlist for $channel.\n"); $self->{pbot}->{logger}->log("Retrieving banlist for $channel.\n");
@ -49,9 +46,7 @@ sub on_endofnames {
return 1; return 1;
} }
sub on_banlist_entry { sub on_banlist_entry($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{args}[1]; my $channel = lc $event->{args}[1];
my $target = lc $event->{args}[2]; my $target = lc $event->{args}[2];
my $source = lc $event->{args}[3]; my $source = lc $event->{args}[3];
@ -63,9 +58,7 @@ sub on_banlist_entry {
return 1; return 1;
} }
sub on_quietlist_entry { sub on_quietlist_entry($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{args}[1]; my $channel = lc $event->{args}[1];
my $target = lc $event->{args}[3]; my $target = lc $event->{args}[3];
my $source = lc $event->{args}[4]; my $source = lc $event->{args}[4];
@ -78,8 +71,7 @@ sub on_quietlist_entry {
return 1; return 1;
} }
sub on_endofbanlist { sub on_endofbanlist($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{args}[1]; my $channel = lc $event->{args}[1];
# first check for saved bans no longer in channel # first check for saved bans no longer in channel
@ -140,8 +132,7 @@ sub on_endofbanlist {
return 1; return 1;
} }
sub on_endofquietlist { sub on_endofquietlist($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{args}[1]; my $channel = lc $event->{args}[1];
my $mute_char = $self->{mute_char}; my $mute_char = $self->{mute_char};
@ -181,9 +172,7 @@ sub on_endofquietlist {
return 1; return 1;
} }
sub on_modeflag { sub on_modeflag($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($source, $channel, $mode, $mask) = ( my ($source, $channel, $mode, $mask) = (
$event->{source}, $event->{source},
$event->{channel}, $event->{channel},

12
lib/PBot/Core/Handlers/Cap.pm
View File

@ -12,18 +12,14 @@ use parent 'PBot::Core::Class';
use POSIX qw/EXIT_FAILURE/; use POSIX qw/EXIT_FAILURE/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# IRCv3 client capabilities # IRCv3 client capabilities
$self->{pbot}->{event_dispatcher}->register_handler('irc.cap', sub { $self->on_cap(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.cap', sub { $self->on_cap(@_) });
} }
# TODO: CAP NEW and CAP DEL # TODO: CAP NEW and CAP DEL
sub on_cap { sub on_cap($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
if ($event->{args}[0] eq 'LS') { if ($event->{args}[0] eq 'LS') {
my $capabilities; my $capabilities;
my $caps_listed = 0; my $caps_listed = 0;
@ -88,9 +84,7 @@ sub on_cap {
return 1; return 1;
} }
sub request_caps { sub request_caps($self, $event) {
my ($self, $event) = @_;
# configure client capabilities that PBot currently supports # configure client capabilities that PBot currently supports
my %desired_caps = ( my %desired_caps = (
'account-notify' => 1, 'account-notify' => 1,

13
lib/PBot/Core/Handlers/ChanOps.pm
View File

@ -13,15 +13,13 @@ use PBot::Imports;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_self_join(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_self_join(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.modeflag', sub { $self->on_modeflag(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.modeflag', sub { $self->on_modeflag(@_) });
} }
sub on_self_join { sub on_self_join($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = $event->{channel}; my $channel = $event->{channel};
delete $self->{pbot}->{chanops}->{is_opped}->{$channel}; delete $self->{pbot}->{chanops}->{is_opped}->{$channel};
@ -34,17 +32,14 @@ sub on_self_join {
return 1; return 1;
} }
sub on_self_part { sub on_self_part($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $channel = $event->{channel}; my $channel = $event->{channel};
delete $self->{pbot}->{chanops}->{is_opped}->{$channel}; delete $self->{pbot}->{chanops}->{is_opped}->{$channel};
delete $self->{pbot}->{chanops}->{op_requested}->{$channel}; delete $self->{pbot}->{chanops}->{op_requested}->{$channel};
return 1; return 1;
} }
sub on_modeflag { sub on_modeflag($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($source, $channel, $mode, $target) = ( my ($source, $channel, $mode, $target) = (
$event->{source}, $event->{source},
$event->{channel}, $event->{channel},

43
lib/PBot/Core/Handlers/Channel.pm
View File

@ -17,9 +17,7 @@ use Encode;
use MIME::Base64; use MIME::Base64;
use Time::HiRes qw/time/; use Time::HiRes qw/time/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.mode', sub { $self->on_mode (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.mode', sub { $self->on_mode (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure (@_) });
@ -33,9 +31,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.modeflag', sub { $self->on_modeflag (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.modeflag', sub { $self->on_modeflag (@_) });
} }
sub on_mode { sub on_mode($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $mode_string, $channel) = ( my ($nick, $user, $host, $mode_string, $channel) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -80,9 +76,7 @@ sub on_mode {
return 1; return 1;
} }
sub on_modeflag { sub on_modeflag($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($source, $channel, $mode, $target) = ( my ($source, $channel, $mode, $target) = (
$event->{source}, $event->{source},
$event->{channel}, $event->{channel},
@ -109,9 +103,7 @@ sub on_modeflag {
return 1; return 1;
} }
sub on_join { sub on_join($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ( my ($nick, $user, $host, $channel) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -161,9 +153,7 @@ sub on_join {
return 1; return 1;
} }
sub on_invite { sub on_invite($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $target, $channel) = ( my ($nick, $user, $host, $target, $channel) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -186,9 +176,7 @@ sub on_invite {
return 1; return 1;
} }
sub on_kick { sub on_kick($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $target, $channel, $reason) = ( my ($nick, $user, $host, $target, $channel, $reason) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -245,9 +233,7 @@ sub on_kick {
return 1; return 1;
} }
sub on_departure { sub on_departure($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel, $args) = ( my ($nick, $user, $host, $channel, $args) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -293,9 +279,7 @@ sub on_departure {
return 1; return 1;
} }
sub on_channelmodeis { sub on_channelmodeis($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my (undef, $channel, $modes) = $event->args; my (undef, $channel, $modes) = $event->args;
$self->{pbot}->{logger}->log("Channel $channel modes: $modes\n"); $self->{pbot}->{logger}->log("Channel $channel modes: $modes\n");
@ -304,9 +288,7 @@ sub on_channelmodeis {
return 1; return 1;
} }
sub on_channelcreate { sub on_channelcreate($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($owner, $channel, $timestamp) = $event->args; my ($owner, $channel, $timestamp) = $event->args;
$self->{pbot}->{logger}->log("Channel $channel created by $owner on " . localtime($timestamp) . "\n"); $self->{pbot}->{logger}->log("Channel $channel created by $owner on " . localtime($timestamp) . "\n");
@ -316,9 +298,7 @@ sub on_channelcreate {
return 1; return 1;
} }
sub on_topic { sub on_topic($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
if (not length $event->{to}[0]) { if (not length $event->{to}[0]) {
# on join # on join
my (undef, $channel, $topic) = $event->args; my (undef, $channel, $topic) = $event->args;
@ -339,8 +319,7 @@ sub on_topic {
return 1; return 1;
} }
sub on_topicinfo { sub on_topicinfo($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my (undef, $channel, $by, $timestamp) = $event->args; my (undef, $channel, $by, $timestamp) = $event->args;
$self->{pbot}->{logger}->log("Topic for $channel set by $by on " . localtime($timestamp) . "\n"); $self->{pbot}->{logger}->log("Topic for $channel set by $by on " . localtime($timestamp) . "\n");
$self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_BY', $by, 1); $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_BY', $by, 1);

20
lib/PBot/Core/Handlers/Chat.pm
View File

@ -10,18 +10,14 @@ package PBot::Core::Handlers::Chat;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.notice', sub { $self->on_notice (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.notice', sub { $self->on_notice (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.msg', sub { $self->on_msg (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.msg', sub { $self->on_msg (@_) });
} }
sub on_notice { sub on_notice($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $to, $text) = ( my ($nick, $user, $host, $to, $text) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -49,9 +45,7 @@ sub on_notice {
return 1; return 1;
} }
sub on_public { sub on_public($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($from, $nick, $user, $host, $text, $tags) = ( my ($from, $nick, $user, $host, $text, $tags) = (
$event->{to}[0], $event->{to}[0],
$event->nick, $event->nick,
@ -69,9 +63,7 @@ sub on_public {
return 1; return 1;
} }
sub on_action { sub on_action($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
# prepend "/me " to the message text # prepend "/me " to the message text
$event->{args}[0] = "/me " . $event->{args}[0]; $event->{args}[0] = "/me " . $event->{args}[0];
@ -80,9 +72,7 @@ sub on_action {
return 1; return 1;
} }
sub on_msg { sub on_msg($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $text, $tags) = ( my ($nick, $user, $host, $text, $tags) = (
$event->nick, $event->nick,
$event->user, $event->user,

42
lib/PBot/Core/Handlers/NickList.pm
View File

@ -12,9 +12,7 @@ use parent 'PBot::Core::Class';
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# handlers for various IRC events (0 is highest priority, 100 is lowest priority) # handlers for various IRC events (0 is highest priority, 100 is lowest priority)
# highest priority so these get handled by NickList before any other handlers # highest priority so these get handled by NickList before any other handlers
@ -37,8 +35,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) }, 0); $self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) }, 0);
} }
sub on_namreply { sub on_namreply($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($channel, $nicks) = ($event->{args}[2], $event->{args}[3]); my ($channel, $nicks) = ($event->{args}[2], $event->{args}[3]);
foreach my $nick (split ' ', $nicks) { foreach my $nick (split ' ', $nicks) {
@ -67,9 +64,7 @@ sub on_namreply {
return 1; return 1;
} }
sub on_activity { sub on_activity($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->{to}[0]); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->{to}[0]);
$self->{pbot}->{nicklist}->update_timestamp($channel, $nick); $self->{pbot}->{nicklist}->update_timestamp($channel, $nick);
@ -77,9 +72,7 @@ sub on_activity {
return 1; return 1;
} }
sub on_join { sub on_join($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
$self->{pbot}->{nicklist}->add_nick($channel, $nick); $self->{pbot}->{nicklist}->add_nick($channel, $nick);
@ -87,14 +80,12 @@ sub on_join {
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'hostmask', "$nick!$user\@$host"); $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'hostmask', "$nick!$user\@$host");
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'user', $user); $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'user', $user);
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'host', $host); $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'host', $host);
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'join', gettimeofday); $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'join', scalar gettimeofday);
return 1; return 1;
} }
sub on_part { sub on_part($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
$self->{pbot}->{nicklist}->remove_nick($channel, $nick); $self->{pbot}->{nicklist}->remove_nick($channel, $nick);
@ -102,9 +93,7 @@ sub on_part {
return 1; return 1;
} }
sub on_quit { sub on_quit($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host); my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) { foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) {
@ -116,9 +105,7 @@ sub on_quit {
return 1; return 1;
} }
sub on_kick { sub on_kick($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $channel) = ($event->to, $event->{args}[0]); my ($nick, $channel) = ($event->to, $event->{args}[0]);
$self->{pbot}->{nicklist}->remove_nick($channel, $nick); $self->{pbot}->{nicklist}->remove_nick($channel, $nick);
@ -126,8 +113,7 @@ sub on_kick {
return 1; return 1;
} }
sub on_nickchange { sub on_nickchange($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $newnick) = ($event->nick, $event->user, $event->host, $event->args); my ($nick, $user, $host, $newnick) = ($event->nick, $event->user, $event->host, $event->args);
foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) { foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) {
@ -144,9 +130,7 @@ sub on_nickchange {
return 1; return 1;
} }
sub on_modeflag { sub on_modeflag($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($source, $channel, $mode, $target) = ( my ($source, $channel, $mode, $target) = (
$event->{source}, $event->{source},
$event->{channel}, $event->{channel},
@ -168,15 +152,13 @@ sub on_modeflag {
return 1; return 1;
} }
sub on_self_join { sub on_self_join($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
# clear nicklist to remove any stale nicks before repopulating with namreplies # clear nicklist to remove any stale nicks before repopulating with namreplies
$self->{pbot}->{nicklist}->remove_channel($event->{channel}); $self->{pbot}->{nicklist}->remove_channel($event->{channel});
return 1; return 1;
} }
sub on_self_part { sub on_self_part($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{nicklist}->remove_channel($event->{channel}); $self->{pbot}->{nicklist}->remove_channel($event->{channel});
return 1; return 1;
} }

16
lib/PBot/Core/Handlers/NickServ.pm
View File

@ -10,9 +10,7 @@ package PBot::Core::Handlers::NickServ;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# NickServ-related IRC events get priority 10 # NickServ-related IRC events get priority 10
# priority is from 0 to 100 where 0 is highest and 100 is lowest # priority is from 0 to 100 where 0 is highest and 100 is lowest
$self->{pbot}->{event_dispatcher}->register_handler('irc.welcome', sub { $self->on_welcome (@_) }, 10); $self->{pbot}->{event_dispatcher}->register_handler('irc.welcome', sub { $self->on_welcome (@_) }, 10);
@ -20,9 +18,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse (@_) }, 10); $self->{pbot}->{event_dispatcher}->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse (@_) }, 10);
} }
sub on_welcome { sub on_welcome($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
# if not using SASL, identify the old way by msging NickServ or some services bot # if not using SASL, identify the old way by msging NickServ or some services bot
if (not $self->{pbot}->{irc_capabilities}->{sasl}) { if (not $self->{pbot}->{irc_capabilities}->{sasl}) {
if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) { if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) {
@ -57,9 +53,7 @@ sub on_welcome {
return undef; return undef;
} }
sub on_notice { sub on_notice($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $to, $text) = ( my ($nick, $user, $host, $to, $text) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -107,9 +101,7 @@ sub on_notice {
return undef; return undef;
} }
sub on_nicknameinuse { sub on_nicknameinuse($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my (undef, $nick, $msg) = $event->args; my (undef, $nick, $msg) = $event->args;
my $from = $event->from; my $from = $event->from;

35
lib/PBot/Core/Handlers/SASL.pm
View File

@ -14,9 +14,7 @@ use POSIX qw/EXIT_FAILURE/;
use Encode; use Encode;
use MIME::Base64; use MIME::Base64;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.authenticate', sub { $self->on_sasl_authenticate (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.authenticate', sub { $self->on_sasl_authenticate (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedin', sub { $self->on_rpl_loggedin (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedin', sub { $self->on_rpl_loggedin (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedout', sub { $self->on_rpl_loggedout (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedout', sub { $self->on_rpl_loggedout (@_) });
@ -29,9 +27,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_saslmechs', sub { $self->on_rpl_saslmechs (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_saslmechs', sub { $self->on_rpl_saslmechs (@_) });
} }
sub on_sasl_authenticate { sub on_sasl_authenticate($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $nick = $self->{pbot}->{registry}->get_value('irc', 'identify_nick'); # try identify_nick my $nick = $self->{pbot}->{registry}->get_value('irc', 'identify_nick'); # try identify_nick
$nick //= $self->{pbot}->{registry}->get_value('irc', 'botnick'); # fallback to botnick $nick //= $self->{pbot}->{registry}->get_value('irc', 'botnick'); # fallback to botnick
my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password');
@ -59,57 +55,48 @@ sub on_sasl_authenticate {
return 1; return 1;
} }
sub on_rpl_loggedin { sub on_rpl_loggedin($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[3] . "\n"); $self->{pbot}->{logger}->log($event->{args}[3] . "\n");
return 1; return 1;
} }
sub on_rpl_loggedout { sub on_rpl_loggedout($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
return 1; return 1;
} }
sub on_err_nicklocked { sub on_err_nicklocked($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE); $self->{pbot}->exit(EXIT_FAILURE);
} }
sub on_rpl_saslsuccess { sub on_rpl_saslsuccess($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$event->{conn}->sl("CAP END"); $event->{conn}->sl("CAP END");
return 1; return 1;
} }
sub on_err_saslfail { sub on_err_saslfail($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE); $self->{pbot}->exit(EXIT_FAILURE);
} }
sub on_err_sasltoolong { sub on_err_sasltoolong($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE); $self->{pbot}->exit(EXIT_FAILURE);
} }
sub on_err_saslaborted { sub on_err_saslaborted($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE); $self->{pbot}->exit(EXIT_FAILURE);
} }
sub on_err_saslalready { sub on_err_saslalready($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{args}[1] . "\n"); $self->{pbot}->{logger}->log($event->{args}[1] . "\n");
return 1; return 1;
} }
sub on_rpl_saslmechs { sub on_rpl_saslmechs($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log("SASL mechanism not available.\n"); $self->{pbot}->{logger}->log("SASL mechanism not available.\n");
$self->{pbot}->{logger}->log("Available mechanisms are: $event->{args}[1]\n"); $self->{pbot}->{logger}->log("Available mechanisms are: $event->{args}[1]\n");
$self->{pbot}->exit(EXIT_FAILURE); $self->{pbot}->exit(EXIT_FAILURE);

44
lib/PBot/Core/Handlers/Server.pm
View File

@ -14,9 +14,7 @@ use PBot::Core::MessageHistory::Constants ':all';
use Time::HiRes qw/time/; use Time::HiRes qw/time/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.welcome', sub { $self->on_welcome (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.welcome', sub { $self->on_welcome (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.disconnect', sub { $self->on_disconnect (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.disconnect', sub { $self->on_disconnect (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.motd', sub { $self->on_motd (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.motd', sub { $self->on_motd (@_) });
@ -33,17 +31,14 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.chghost', sub { $self->on_chghost (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.chghost', sub { $self->on_chghost (@_) });
} }
sub on_init { sub on_init($self, $conn, $event) {
my ($self, $conn, $event) = @_;
my (@args) = ($event->args); my (@args) = ($event->args);
shift @args; shift @args;
$self->{pbot}->{logger}->log("*** @args\n"); $self->{pbot}->{logger}->log("*** @args\n");
return 1; return 1;
} }
sub on_welcome { sub on_welcome($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log("Welcome!\n"); $self->{pbot}->{logger}->log("Welcome!\n");
if ($self->{pbot}->{irc_capabilities}->{sasl}) { if ($self->{pbot}->{irc_capabilities}->{sasl}) {
@ -55,9 +50,7 @@ sub on_welcome {
return 1; return 1;
} }
sub on_disconnect { sub on_disconnect($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log("Disconnected...\n"); $self->{pbot}->{logger}->log("Disconnected...\n");
$self->{pbot}->{conn} = undef; $self->{pbot}->{conn} = undef;
@ -73,9 +66,7 @@ sub on_disconnect {
return 1; return 1;
} }
sub on_motd { sub on_motd($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
if ($self->{pbot}->{registry}->get_value('irc', 'show_motd')) { if ($self->{pbot}->{registry}->get_value('irc', 'show_motd')) {
my $from = $event->{from}; my $from = $event->{from};
my $msg = $event->{args}[1]; my $msg = $event->{args}[1];
@ -85,9 +76,7 @@ sub on_motd {
return 1; return 1;
} }
sub on_notice { sub on_notice($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($server, $to, $text) = ( my ($server, $to, $text) = (
$event->nick, $event->nick,
$event->to, $event->to,
@ -103,9 +92,7 @@ sub on_notice {
return 1; return 1;
} }
sub on_isupport { sub on_isupport($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
# remove and discard first and last arguments # remove and discard first and last arguments
# (first arg is botnick, last arg is "are supported by this server") # (first arg is botnick, last arg is "are supported by this server")
shift @{$event->{args}}; shift @{$event->{args}};
@ -131,8 +118,7 @@ sub on_isupport {
return 1; return 1;
} }
sub on_nickchange { sub on_nickchange($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $newnick) = ($event->nick, $event->user, $event->host, $event->args); my ($nick, $user, $host, $newnick) = ($event->nick, $event->user, $event->host, $event->args);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
@ -167,9 +153,7 @@ sub on_nickchange {
return 1; return 1;
} }
sub on_nononreg { sub on_nononreg($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $target = $event->{args}[1]; my $target = $event->{args}[1];
$self->{pbot}->{logger}->log("Cannot send private /msg to $target; they are blocking unidentified /msgs.\n"); $self->{pbot}->{logger}->log("Cannot send private /msg to $target; they are blocking unidentified /msgs.\n");
@ -177,9 +161,7 @@ sub on_nononreg {
return 1; return 1;
} }
sub on_chghost { sub on_chghost($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my $nick = $event->nick; my $nick = $event->nick;
my $user = $event->user; my $user = $event->user;
my $host = $event->host; my $host = $event->host;
@ -212,14 +194,12 @@ sub on_chghost {
return 1; return 1;
} }
sub log_first_arg { sub log_first_arg($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log("$event->{args}[1]\n"); $self->{pbot}->{logger}->log("$event->{args}[1]\n");
return 1; return 1;
} }
sub log_third_arg { sub log_third_arg($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log("$event->{args}[3]\n"); $self->{pbot}->{logger}->log("$event->{args}[3]\n");
return 1; return 1;
} }

16
lib/PBot/Core/Handlers/Users.pm
View File

@ -10,8 +10,7 @@ package PBot::Core::Handlers::Users;
use PBot::Imports; use PBot::Imports;
use parent 'PBot::Core::Class'; use parent 'PBot::Core::Class';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.quit', sub { $self->on_departure (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.quit', sub { $self->on_departure (@_) });
@ -19,9 +18,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part (@_) }); $self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part (@_) });
} }
sub on_join { sub on_join($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ( my ($nick, $user, $host, $channel) = (
$event->nick, $event->nick,
$event->user, $event->user,
@ -65,24 +62,21 @@ sub on_join {
return 1; return 1;
} }
sub on_departure { sub on_departure($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host"); $self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host");
return 1; return 1;
} }
sub on_kick { sub on_kick($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->{args}[0]); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->{args}[0]);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host"); $self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host");
return 1; return 1;
} }
sub on_self_part { sub on_self_part($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
delete $self->{pbot}->{users}->{user_cache}->{lc $event->{channel}}; delete $self->{pbot}->{users}->{user_cache}->{lc $event->{channel}};
return 1; return 1;
} }

15
lib/PBot/Core/IRCHandlers.pm
View File

@ -19,10 +19,7 @@ sub initialize {
# this default handler prepends 'irc.' to the event-name and then dispatches # this default handler prepends 'irc.' to the event-name and then dispatches
# the event to the rest of PBot via PBot::Core::EventDispatcher. # the event to the rest of PBot via PBot::Core::EventDispatcher.
sub default_handler($self, $conn, $event) {
sub default_handler {
my ($self, $conn, $event) = @_;
# add conn to event object so we can access it within handlers # add conn to event object so we can access it within handlers
$event->{conn} = $conn; $event->{conn} = $conn;
@ -42,10 +39,7 @@ sub default_handler {
} }
# registers handlers with a PBot::Core::IRC connection # registers handlers with a PBot::Core::IRC connection
sub add_handlers($self) {
sub add_handlers {
my ($self) = @_;
# set up handlers for the IRC engine # set up handlers for the IRC engine
$self->{pbot}->{conn}->add_default_handler( $self->{pbot}->{conn}->add_default_handler(
sub { $self->default_handler(@_) }, 1); sub { $self->default_handler(@_) }, 1);
@ -71,10 +65,7 @@ sub add_handlers {
} }
# replace randomized gibberish in certain hostmasks with identifying information # replace randomized gibberish in certain hostmasks with identifying information
sub normalize_hostmask($self, $nick, $user, $host) {
sub normalize_hostmask {
my ($self, $nick, $user, $host) = @_;
if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) { if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) {
$host = "$1/$2/x-$user"; $host = "$1/$2/x-$user";
} }

19
lib/PBot/Core/IgnoreList.pm
View File

@ -12,9 +12,7 @@ use PBot::Imports;
use Time::Duration qw/duration/; use Time::Duration qw/duration/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{filename} = $conf{filename}; $self->{filename} = $conf{filename};
$self->{storage} = PBot::Core::Storage::DualIndexHashObject->new( $self->{storage} = PBot::Core::Storage::DualIndexHashObject->new(
@ -27,8 +25,7 @@ sub initialize {
$self->enqueue_ignores; $self->enqueue_ignores;
} }
sub enqueue_ignores { sub enqueue_ignores($self) {
my ($self) = @_;
my $now = time; my $now = time;
foreach my $channel ($self->{storage}->get_keys) { foreach my $channel ($self->{storage}->get_keys) {
@ -47,9 +44,7 @@ sub enqueue_ignores {
} }
} }
sub add { sub add($self, $channel, $hostmask, $length, $owner) {
my ($self, $channel, $hostmask, $length, $owner) = @_;
if ($hostmask !~ /!/) { if ($hostmask !~ /!/) {
$hostmask .= '!*@*'; $hostmask .= '!*@*';
} elsif ($hostmask !~ /@/) { } elsif ($hostmask !~ /@/) {
@ -89,9 +84,7 @@ sub add {
return "$hostmask ignored for $duration"; return "$hostmask ignored for $duration";
} }
sub remove { sub remove($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
if ($hostmask !~ /!/) { if ($hostmask !~ /!/) {
$hostmask .= '!*@*'; $hostmask .= '!*@*';
} elsif ($hostmask !~ /@/) { } elsif ($hostmask !~ /@/) {
@ -104,9 +97,7 @@ sub remove {
return $self->{storage}->remove($channel, $hostmask); return $self->{storage}->remove($channel, $hostmask);
} }
sub is_ignored { sub is_ignored($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
return 0 if $self->{pbot}->{users}->loggedin_admin($channel, $hostmask); return 0 if $self->{pbot}->{users}->loggedin_admin($channel, $hostmask);
foreach my $chan ('.*', $channel) { foreach my $chan ('.*', $channel) {

97
lib/PBot/Core/Interpreter.pm
View File

@ -24,9 +24,7 @@ use Time::Duration;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
use Unicode::Truncate; use Unicode::Truncate;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# PBot::Core::Interpreter can register multiple interpreter subrefs. # PBot::Core::Interpreter can register multiple interpreter subrefs.
# See also: Commands::interpreter() and Factoids::interpreter() # See also: Commands::interpreter() and Factoids::interpreter()
$self->PBot::Core::Registerable::initialize(%conf); $self->PBot::Core::Registerable::initialize(%conf);
@ -37,9 +35,7 @@ sub initialize {
# this is the main entry point for a message to be parsed into commands # this is the main entry point for a message to be parsed into commands
# and to execute those commands and process their output # and to execute those commands and process their output
sub process_line { sub process_line($self, $from, $nick, $user, $host, $text, $tags = '', $is_command = 0) {
my ($self, $from, $nick, $user, $host, $text, $tags, $is_command) = @_;
# lowercase `from` field for case-insensitivity # lowercase `from` field for case-insensitivity
$from = lc $from; $from = lc $from;
@ -250,9 +246,7 @@ sub process_line {
# main entry point to interpret/execute a bot command. # main entry point to interpret/execute a bot command.
# takes a $context object containing contextual information about the # takes a $context object containing contextual information about the
# command such as the channel, nick, user, host, command, etc. # command such as the channel, nick, user, host, command, etc.
sub interpret { sub interpret($self, $context) {
my ($self, $context) = @_;
# log command invocation # log command invocation
$self->{pbot}->{logger}->log("=== [$context->{interpret_depth}] Got command: " $self->{pbot}->{logger}->log("=== [$context->{interpret_depth}] Got command: "
. "($context->{from}) $context->{hostmask}: $context->{command}\n"); . "($context->{from}) $context->{hostmask}: $context->{command}\n");
@ -555,12 +549,8 @@ sub interpret {
# finalizes processing on a command. # finalizes processing on a command.
# updates pipes, substitutions, splits. truncates to paste site. # updates pipes, substitutions, splits. truncates to paste site.
# sends final command output to appropriate queues. # sends final command output to appropriate queues.
sub handle_result { # use context result if no result argument given.
my ($self, $context, $result) = @_; sub handle_result($self, $context, $result = $context->{result}) {
# use context result if no result argument given
$result //= $context->{result};
# ensure we have a command result to work with # ensure we have a command result to work with
return if not defined $result or not length $result; return if not defined $result or not length $result;
@ -747,9 +737,7 @@ sub handle_result {
# truncates a message, optionally pasting to a web paste site. # truncates a message, optionally pasting to a web paste site.
# $paste_text is the version of text (e.g. with whitespace formatting preserved, etc) # $paste_text is the version of text (e.g. with whitespace formatting preserved, etc)
# to send to the paste site. # to send to the paste site.
sub truncate_result { sub truncate_result($self, $context, $text, $paste_text) {
my ($self, $context, $text, $paste_text) = @_;
my $max_msg_len = $self->{pbot}->{registry}->get_value('irc', 'max_msg_len'); my $max_msg_len = $self->{pbot}->{registry}->get_value('irc', 'max_msg_len');
$max_msg_len -= length "PRIVMSG $context->{from} :"; $max_msg_len -= length "PRIVMSG $context->{from} :";
@ -810,6 +798,7 @@ my @dehighlight_exclusions = qw/auto if unsigned break inline void case int vola
sub dehighlight_nicks { sub dehighlight_nicks {
my ($self, $line, $channel) = @_; my ($self, $line, $channel) = @_;
sub dehighlight_nicks($self, $line, $channel) {
return $line if $self->{pbot}->{registry}->get_value('general', 'no_dehighlight_nicks'); return $line if $self->{pbot}->{registry}->get_value('general', 'no_dehighlight_nicks');
my @tokens = split / /, $line; my @tokens = split / /, $line;
@ -832,9 +821,7 @@ sub dehighlight_nicks {
return join ' ', @tokens; return join ' ', @tokens;
} }
sub output_result { sub output_result($self, $context) {
my ($self, $context) = @_;
# debug flag to trace $context location and contents # debug flag to trace $context location and contents
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper; use Data::Dumper;
@ -943,9 +930,7 @@ sub output_result {
} }
} }
sub add_message_to_output_queue { sub add_message_to_output_queue($self, $channel, $message, $delay = 0) {
my ($self, $channel, $message, $delay) = @_;
$self->{pbot}->{event_queue}->enqueue_event( $self->{pbot}->{event_queue}->enqueue_event(
sub { sub {
my $context = { my $context = {
@ -965,9 +950,7 @@ sub add_message_to_output_queue {
); );
} }
sub add_to_command_queue { sub add_to_command_queue($self, $channel, $command, $delay = 0, $repeating = 0) {
my ($self, $channel, $command, $delay, $repeating) = @_;
$self->{pbot}->{event_queue}->enqueue_event( $self->{pbot}->{event_queue}->enqueue_event(
sub { sub {
my $context = { my $context = {
@ -994,9 +977,7 @@ sub add_to_command_queue {
); );
} }
sub add_botcmd_to_command_queue { sub add_botcmd_to_command_queue($self, $channel, $command, $delay = 0) {
my ($self, $channel, $command, $delay) = @_;
my $botcmd = { my $botcmd = {
nick => $self->{pbot}->{registry}->get_value('irc', 'botnick'), nick => $self->{pbot}->{registry}->get_value('irc', 'botnick'),
user => 'stdin', user => 'stdin',
@ -1012,15 +993,7 @@ sub add_botcmd_to_command_queue {
# extracts a bracketed substring, gracefully handling unbalanced quotes # extracts a bracketed substring, gracefully handling unbalanced quotes
# or brackets. opening and closing brackets may each be more than one character. # or brackets. opening and closing brackets may each be more than one character.
# optional prefix may be or begin with a character group. # optional prefix may be or begin with a character group.
sub extract_bracketed { sub extract_bracketed($self, $string, $open_bracket = '{', $close_bracket = '}', $optional_prefix = '', $allow_whitespace = 0) {
my ($self, $string, $open_bracket, $close_bracket, $optional_prefix, $allow_whitespace) = @_;
# set default values when none provided
$open_bracket //= '{';
$close_bracket //= '}';
$optional_prefix //= '';
$allow_whitespace //= 0;
my @prefix_group; my @prefix_group;
if ($optional_prefix =~ s/^\[(.*?)\]//) { @prefix_group = split //, $1; } if ($optional_prefix =~ s/^\[(.*?)\]//) { @prefix_group = split //, $1; }
@ -1178,9 +1151,7 @@ sub extract_bracketed {
# whitespace or json separators. # whitespace or json separators.
# handles unbalanced quotes gracefully by treating them as # handles unbalanced quotes gracefully by treating them as
# part of the argument they were found within. # part of the argument they were found within.
sub split_line { sub split_line($self, $line, %opts) {
my ($self, $line, %opts) = @_;
my %default_opts = ( my %default_opts = (
strip_quotes => 0, strip_quotes => 0,
keep_spaces => 0, keep_spaces => 0,
@ -1292,9 +1263,7 @@ sub split_line {
} }
# creates an array of arguments from a string # creates an array of arguments from a string
sub make_args { sub make_args($self, $string) {
my ($self, $string) = @_;
my @args = $self->split_line($string, keep_spaces => 1); my @args = $self->split_line($string, keep_spaces => 1);
my @arglist; my @arglist;
@ -1328,44 +1297,37 @@ sub make_args {
} }
# returns size of array of arguments # returns size of array of arguments
sub arglist_size { sub arglist_size($self, $args) {
my ($self, $args) = @_;
return @$args / 2; return @$args / 2;
} }
# unshifts new argument to front # unshifts new argument to front
sub unshift_arg { sub unshift_arg($self, $args, $arg) {
my ($self, $args, $arg) = @_;
splice @$args, @$args / 2, 0, $arg; # add quoted argument splice @$args, @$args / 2, 0, $arg; # add quoted argument
unshift @$args, $arg; # add first argument unshift @$args, $arg; # add first argument
return @$args; return @$args;
} }
# shifts first argument off array of arguments # shifts first argument off array of arguments
sub shift_arg { sub shift_arg($self, $args) {
my ($self, $args) = @_;
return undef if not @$args; return undef if not @$args;
splice @$args, @$args / 2, 1; # remove original quoted argument splice @$args, @$args / 2, 1; # remove original quoted argument
return shift @$args; return shift @$args;
} }
# returns list of unquoted arguments # returns list of unquoted arguments
sub unquoted_args { sub unquoted_args($self, $args) {
my ($self, $args) = @_;
return undef if not @$args; return undef if not @$args;
return @$args[0 .. @$args / 2 - 1]; return @$args[0 .. @$args / 2 - 1];
} }
# splits array of arguments into array with overflow arguments filling up last position # splits array of arguments into array with overflow arguments filling up last position
# split_args(qw/dog cat bird hamster/, 3) => ("dog", "cat", "bird hamster") # split_args(qw/dog cat bird hamster/, 3) => ("dog", "cat", "bird hamster")
sub split_args { sub split_args($self, $args, $count, $offset = 0, $preserve_quotes = 0) {
my ($self, $args, $count, $offset, $preserve_quotes) = @_;
my @result; my @result;
my $max = $self->arglist_size($args); my $max = $self->arglist_size($args);
$preserve_quotes //= 0; my $i = $offset;
my $i = $offset // 0;
unless ($count == 1) { unless ($count == 1) {
do { do {
my $arg = $args->[$i++]; my $arg = $args->[$i++];
@ -1390,33 +1352,26 @@ sub split_args {
} }
# lowercases array of arguments # lowercases array of arguments
sub lc_args { sub lc_args($self, $args) {
my ($self, $args) = @_;
for (my $i = 0; $i < @$args; $i++) { $args->[$i] = lc $args->[$i]; } for (my $i = 0; $i < @$args; $i++) { $args->[$i] = lc $args->[$i]; }
} }
# getopt boilerplate in one place # getopt boilerplate in one place
# 99% of our getopt use is on a string # 99% of our getopt use is on a string
sub getopt { sub getopt($self, @args) {
my $self = shift; $self->getopt_from_string(@args);
$self->getopt_from_string(@_);
} }
# getopt_from_string() uses our split_line() function instead of # getopt_from_string() uses our split_line() function instead of
# Getopt::Long::GetOptionsFromString's Text::ParseWords # Getopt::Long::GetOptionsFromString's Text::ParseWords
sub getopt_from_string { sub getopt_from_string($self, $string, $result, $config, @opts) {
my ($self, $string, $result, $config, @opts) = @_;
my @opt_args = $self->split_line($string, strip_quotes => 1); my @opt_args = $self->split_line($string, strip_quotes => 1);
return $self->getopt_from_array(\@opt_args, $result, $config, @opts); return $self->getopt_from_array(\@opt_args, $result, $config, @opts);
} }
# the workhorse getopt function # the workhorse getopt function
sub getopt_from_array { sub getopt_from_array($self, $opt_args, $result, $config, @opts) {
my ($self, $opt_args, $result, $config, @opts) = @_;
# emitting errors as Perl warnings instead of using die, weird. # emitting errors as Perl warnings instead of using die, weird.
my $opt_error; my $opt_error;
local $SIG{__WARN__} = sub { local $SIG{__WARN__} = sub {
@ -1425,9 +1380,7 @@ sub getopt_from_array {
}; };
Getopt::Long::Configure(@$config); Getopt::Long::Configure(@$config);
GetOptionsFromArray($opt_args, $result, @opts); GetOptionsFromArray($opt_args, $result, @opts);
return ($opt_args, $opt_error); return ($opt_args, $opt_error);
} }

37
lib/PBot/Core/LagChecker.pm
View File

@ -14,9 +14,7 @@ use PBot::Imports;
use Time::HiRes qw(gettimeofday tv_interval); use Time::HiRes qw(gettimeofday tv_interval);
use Time::Duration; use Time::Duration;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# average of entries in lag history, in seconds # average of entries in lag history, in seconds
$self->{lag_average} = undef; $self->{lag_average} = undef;
@ -56,14 +54,11 @@ sub initialize {
} }
# registry trigger fires when value changes # registry trigger fires when value changes
sub trigger_lag_history_interval { sub trigger_lag_history_interval($self, $section, $item, $newvalue) {
my ($self, $section, $item, $newvalue) = @_;
$self->{pbot}->{event_queue}->update_interval('lag check', $newvalue); $self->{pbot}->{event_queue}->update_interval('lag check', $newvalue);
} }
sub send_ping { sub send_ping($self) {
my $self = shift;
return unless defined $self->{pbot}->{conn}; return unless defined $self->{pbot}->{conn};
$self->{ping_send_time} = [gettimeofday]; $self->{ping_send_time} = [gettimeofday];
@ -72,17 +67,13 @@ sub send_ping {
$self->{pbot}->{conn}->sl("PING :lagcheck"); $self->{pbot}->{conn}->sl("PING :lagcheck");
} }
sub on_pong { sub on_pong($self, $event_type, $event) {
my $self = shift;
$self->{pong_received} = 1; $self->{pong_received} = 1;
my $elapsed = tv_interval($self->{ping_send_time}); my $elapsed = tv_interval($self->{ping_send_time});
push @{$self->{lag_history}}, [$self->{ping_send_time}[0], $elapsed * 1000]; push @{$self->{lag_history}}, [$self->{ping_send_time}[0], $elapsed * 1000];
my $len = @{$self->{lag_history}}; my $len = @{$self->{lag_history}};
my $lag_history_max = $self->{pbot}->{registry}->get_value('lagchecker', 'lag_history_max'); my $lag_history_max = $self->{pbot}->{registry}->get_value('lagchecker', 'lag_history_max');
while ($len > $lag_history_max) { while ($len > $lag_history_max) {
@ -97,44 +88,30 @@ sub on_pong {
foreach my $entry (@{$self->{lag_history}}) { foreach my $entry (@{$self->{lag_history}}) {
my ($send_time, $lag_result) = @$entry; my ($send_time, $lag_result) = @$entry;
$lag_total += $lag_result; $lag_total += $lag_result;
my $ago = concise ago(gettimeofday - $send_time); my $ago = concise ago(gettimeofday - $send_time);
push @entries, "[$ago] " . sprintf "%.1f ms", $lag_result; push @entries, "[$ago] " . sprintf "%.1f ms", $lag_result;
} }
$self->{lag_string} = join '; ', @entries; $self->{lag_string} = join '; ', @entries;
$self->{lag_average} = $lag_total / $len; $self->{lag_average} = $lag_total / $len;
$self->{lag_string} .= "; average: " . sprintf "%.1f ms", $self->{lag_average}; $self->{lag_string} .= "; average: " . sprintf "%.1f ms", $self->{lag_average};
return 0; return 0;
} }
sub lagging { sub lagging($self) {
my ($self) = @_;
if (defined $self->{pong_received} and $self->{pong_received} == 0) { if (defined $self->{pong_received} and $self->{pong_received} == 0) {
# a ping has been sent (pong_received is not undef) and no pong has been received yet # a ping has been sent (pong_received is not undef) and no pong has been received yet
my $elapsed = tv_interval($self->{ping_send_time}); my $elapsed = tv_interval($self->{ping_send_time});
return $elapsed >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold'); return $elapsed >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
} }
return 0 if not defined $self->{lag_average}; return 0 if not defined $self->{lag_average};
return $self->{lag_average} >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold'); return $self->{lag_average} >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
} }
sub lagstring { sub lagstring($self) {
my ($self) = @_; return $self->{lag_string} || "initializing";
my $lag = $self->{lag_string} || "initializing";
return $lag;
} }
1; 1;

15
lib/PBot/Core/Logger.pm
View File

@ -15,8 +15,7 @@ use File::Copy;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
use POSIX; use POSIX;
sub new { sub new($class, %args) {
my ($class, %args) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot}; Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot}; $self->{pbot} = delete $args{pbot};
@ -25,9 +24,7 @@ sub new {
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# ensure logfile path was provided # ensure logfile path was provided
$self->{logfile} = $conf{filename} // Carp::croak "Missing logfile parameter in " . __FILE__; $self->{logfile} = $conf{filename} // Carp::croak "Missing logfile parameter in " . __FILE__;
@ -52,9 +49,7 @@ sub initialize {
$self->{pbot}->{atexit}->register(sub { $self->rotate_log }); $self->{pbot}->{atexit}->register(sub { $self->rotate_log });
} }
sub log { sub log($self, $text) {
my ($self, $text) = @_;
# get current time # get current time
my ($sec, $usec) = gettimeofday; my ($sec, $usec) = gettimeofday;
my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec; my $time = strftime "%a %b %e %Y %H:%M:%S", localtime $sec;
@ -70,9 +65,7 @@ sub log {
print STDOUT "$time :: $text" unless $self->{pbot}->{overrides}->{'general.daemon'}; print STDOUT "$time :: $text" unless $self->{pbot}->{overrides}->{'general.daemon'};
} }
sub rotate_log { sub rotate_log($self) {
my ($self) = @_;
# get start time # get start time
my $time = localtime $self->{start}; my $time = localtime $self->{start};
$time =~ s/\s+/_/g; # replace spaces with underscores $time =~ s/\s+/_/g; # replace spaces with underscores

9
lib/PBot/Core/MessageHistory.pm
View File

@ -18,8 +18,7 @@ use Time::HiRes qw(time tv_interval);
use PBot::Core::MessageHistory::Storage::SQLite; use PBot::Core::MessageHistory::Storage::SQLite;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3'; $self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3';
$self->{database} = PBot::Core::MessageHistory::Storage::SQLite->new( $self->{database} = PBot::Core::MessageHistory::Storage::SQLite->new(
@ -35,13 +34,11 @@ sub initialize {
$self->{pbot}->{atexit}->register(sub { $self->{database}->end }); $self->{pbot}->{atexit}->register(sub { $self->{database}->end });
} }
sub get_message_account { sub get_message_account($self, $nick, $user, $host) {
my ($self, $nick, $user, $host) = @_;
return $self->{database}->get_message_account($nick, $user, $host); return $self->{database}->get_message_account($nick, $user, $host);
} }
sub add_message { sub add_message($self, $account, $mask, $channel, $text, $mode) {
my ($self, $account, $mask, $channel, $text, $mode) = @_;
$self->{database}->add_message($account, $mask, $channel, { timestamp => scalar time, msg => $text, mode => $mode }); $self->{database}->add_message($account, $mask, $channel, { timestamp => scalar time, msg => $text, mode => $mode });
} }

232
lib/PBot/Core/MessageHistory/Storage/SQLite.pm
View File

@ -26,9 +26,7 @@ use Text::CSV;
use Text::Levenshtein::XS qw/distance/; use Text::Levenshtein::XS qw/distance/;
use Time::Duration; use Time::Duration;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3'; $self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3';
$self->{new_entries} = 0; $self->{new_entries} = 0;
@ -49,14 +47,11 @@ sub initialize {
'messagehistory commit'); 'messagehistory commit');
} }
sub sqlite_commit_interval_trigger { sub sqlite_commit_interval_trigger($self, $section, $item, $newvalue) {
my ($self, $section, $item, $newvalue) = @_;
$self->{pbot}->{event_queue}->update_interval('messagehistory commit', $newvalue); $self->{pbot}->{event_queue}->update_interval('messagehistory commit', $newvalue);
} }
sub sqlite_debug_trigger { sub sqlite_debug_trigger($self, $section, $item, $newvalue) {
my ($self, $section, $item, $newvalue) = @_;
if ($newvalue) { if ($newvalue) {
open $self->{trace_layer}, '>:via(PBot::Core::Utils::SQLiteLoggerLayer)', PBot::Core::Utils::SQLiteLogger->new(pbot => $self->{pbot}); open $self->{trace_layer}, '>:via(PBot::Core::Utils::SQLiteLoggerLayer)', PBot::Core::Utils::SQLiteLogger->new(pbot => $self->{pbot});
} else { } else {
@ -67,9 +62,7 @@ sub sqlite_debug_trigger {
$self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh}; $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh};
} }
sub begin { sub begin($self) {
my $self = shift;
$self->{pbot}->{logger}->log("Opening message history SQLite database: $self->{filename}\n"); $self->{pbot}->{logger}->log("Opening message history SQLite database: $self->{filename}\n");
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1}) $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
@ -170,9 +163,7 @@ SQL
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub end { sub end($self) {
my $self = shift;
$self->{pbot}->{logger}->log("Closing message history SQLite database\n"); $self->{pbot}->{logger}->log("Closing message history SQLite database\n");
if (exists $self->{dbh} and defined $self->{dbh}) { if (exists $self->{dbh} and defined $self->{dbh}) {
@ -183,9 +174,7 @@ sub end {
} }
} }
sub get_gecos { sub get_gecos($self, $id) {
my ($self, $id) = @_;
my $gecos = eval { my $gecos = eval {
my $sth = $self->{dbh}->prepare('SELECT gecos FROM Gecos WHERE id = ?'); my $sth = $self->{dbh}->prepare('SELECT gecos FROM Gecos WHERE id = ?');
$sth->execute($id); $sth->execute($id);
@ -195,9 +184,7 @@ sub get_gecos {
return map { $_->[0] } @$gecos; return map { $_->[0] } @$gecos;
} }
sub get_nickserv_accounts { sub get_nickserv_accounts($self, $id) {
my ($self, $id) = @_;
my $nickserv_accounts = eval { my $nickserv_accounts = eval {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Nickserv WHERE id = ?'); my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Nickserv WHERE id = ?');
$sth->execute($id); $sth->execute($id);
@ -207,9 +194,7 @@ sub get_nickserv_accounts {
return map { $_->[0] } @$nickserv_accounts; return map { $_->[0] } @$nickserv_accounts;
} }
sub delete_nickserv_accounts { sub delete_nickserv_accounts($self, $id) {
my ($self, $id) = @_;
eval { eval {
$self->{dbh}->do('DELETE FROM Nickserv WHERE id = ?', undef, $id); $self->{dbh}->do('DELETE FROM Nickserv WHERE id = ?', undef, $id);
$self->{dbh}->commit; $self->{dbh}->commit;
@ -224,9 +209,7 @@ sub delete_nickserv_accounts {
return 1; return 1;
} }
sub set_current_nickserv_account { sub set_current_nickserv_account($self, $id, $nickserv) {
my ($self, $id, $nickserv) = @_;
eval { eval {
my $sth = $self->{dbh}->prepare('UPDATE Accounts SET nickserv = ? WHERE id = ?'); my $sth = $self->{dbh}->prepare('UPDATE Accounts SET nickserv = ? WHERE id = ?');
$sth->execute($nickserv, $id); $sth->execute($nickserv, $id);
@ -239,9 +222,7 @@ sub set_current_nickserv_account {
} }
} }
sub get_current_nickserv_account { sub get_current_nickserv_account($self, $id) {
my ($self, $id) = @_;
my $nickserv = eval { my $nickserv = eval {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Accounts WHERE id = ?'); my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Accounts WHERE id = ?');
$sth->execute($id); $sth->execute($id);
@ -252,9 +233,7 @@ sub get_current_nickserv_account {
return $nickserv; return $nickserv;
} }
sub create_nickserv { sub create_nickserv($self, $id, $nickserv) {
my ($self, $id, $nickserv) = @_;
eval { eval {
my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Nickserv VALUES (?, ?, 0)'); my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Nickserv VALUES (?, ?, 0)');
$sth->execute($id, $nickserv); $sth->execute($id, $nickserv);
@ -263,9 +242,7 @@ sub create_nickserv {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub update_nickserv_account { sub update_nickserv_account($self, $id, $nickserv, $timestamp) {
my ($self, $id, $nickserv, $timestamp) = @_;
$self->create_nickserv($id, $nickserv); $self->create_nickserv($id, $nickserv);
eval { eval {
@ -276,9 +253,7 @@ sub update_nickserv_account {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub create_gecos { sub create_gecos($self, $id, $gecos) {
my ($self, $id, $gecos) = @_;
eval { eval {
my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Gecos VALUES (?, ?, 0)'); my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Gecos VALUES (?, ?, 0)');
my $rv = $sth->execute($id, $gecos); my $rv = $sth->execute($id, $gecos);
@ -287,9 +262,7 @@ sub create_gecos {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub update_gecos { sub update_gecos($self, $id, $gecos, $timestamp) {
my ($self, $id, $gecos, $timestamp) = @_;
$self->create_gecos($id, $gecos); $self->create_gecos($id, $gecos);
eval { eval {
@ -300,9 +273,7 @@ sub update_gecos {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub add_message_account { sub add_message_account($self, $mask, $link_id = undef, $link_type = undef) {
my ($self, $mask, $link_id, $link_type) = @_;
my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/; my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/;
my $id; my $id;
@ -339,9 +310,7 @@ sub add_message_account {
return $id; return $id;
} }
sub find_message_account_by_id { sub find_message_account_by_id($self, $id) {
my ($self, $id) = @_;
my $hostmask = eval { my $hostmask = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmask FROM Hostmasks WHERE id = ? ORDER BY last_seen DESC LIMIT 1'); my $sth = $self->{dbh}->prepare('SELECT hostmask FROM Hostmasks WHERE id = ? ORDER BY last_seen DESC LIMIT 1');
$sth->execute($id); $sth->execute($id);
@ -353,9 +322,7 @@ sub find_message_account_by_id {
return $hostmask; return $hostmask;
} }
sub find_message_account_by_nick { sub find_message_account_by_nick($self, $nick) {
my ($self, $nick) = @_;
my ($id, $hostmask) = eval { my ($id, $hostmask) = eval {
my $sth = $self->{dbh}->prepare('SELECT id, hostmask FROM Hostmasks WHERE nick = ? ORDER BY last_seen DESC LIMIT 1'); my $sth = $self->{dbh}->prepare('SELECT id, hostmask FROM Hostmasks WHERE nick = ? ORDER BY last_seen DESC LIMIT 1');
$sth->execute($nick); $sth->execute($nick);
@ -367,9 +334,7 @@ sub find_message_account_by_nick {
return ($id, $hostmask); return ($id, $hostmask);
} }
sub find_message_accounts_by_nickserv { sub find_message_accounts_by_nickserv($self, $nickserv) {
my ($self, $nickserv) = @_;
my $accounts = eval { my $accounts = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Nickserv WHERE nickserv = ? ORDER BY timestamp DESC'); my $sth = $self->{dbh}->prepare('SELECT id FROM Nickserv WHERE nickserv = ? ORDER BY timestamp DESC');
$sth->execute($nickserv); $sth->execute($nickserv);
@ -379,11 +344,7 @@ sub find_message_accounts_by_nickserv {
return map { $_->[0] } @$accounts; return map { $_->[0] } @$accounts;
} }
sub find_message_accounts_by_mask { sub find_message_accounts_by_mask($self, $mask, $limit = 100) {
my ($self, $mask, $limit) = @_;
$limit //= 100;
my $qmask = quotemeta $mask; my $qmask = quotemeta $mask;
$qmask =~ s/_/\\_/g; $qmask =~ s/_/\\_/g;
$qmask =~ s/\\\./_/g; $qmask =~ s/\\\./_/g;
@ -400,16 +361,13 @@ sub find_message_accounts_by_mask {
return map { $_->[0] } @$accounts; return map { $_->[0] } @$accounts;
} }
sub get_message_account_ancestor { sub get_message_account_ancestor($self, @args) {
my $self = shift; my $id = $self->get_message_account(@args);
my $id = $self->get_message_account(@_);
$id = $self->get_ancestor_id($id); $id = $self->get_ancestor_id($id);
return $id; return $id;
} }
sub get_message_account { sub get_message_account($self, $nick, $user, $host, $orig_nick = undef) {
my ($self, $nick, $user, $host, $orig_nick) = @_;
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
=cut =cut
@ -801,9 +759,7 @@ sub get_message_account {
return $self->add_message_account($mask); return $self->add_message_account($mask);
} }
sub find_most_recent_hostmask { sub find_most_recent_hostmask($self, $id) {
my ($self, $id) = @_;
my $hostmask = eval { my $hostmask = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmask FROM Hostmasks WHERE ID = ? ORDER BY last_seen DESC LIMIT 1'); my $sth = $self->{dbh}->prepare('SELECT hostmask FROM Hostmasks WHERE ID = ? ORDER BY last_seen DESC LIMIT 1');
$sth->execute($id); $sth->execute($id);
@ -814,9 +770,7 @@ sub find_most_recent_hostmask {
return $hostmask; return $hostmask;
} }
sub update_hostmask_data { sub update_hostmask_data($self, $mask, $data) {
my ($self, $mask, $data) = @_;
eval { eval {
my $sql = 'UPDATE Hostmasks SET '; my $sql = 'UPDATE Hostmasks SET ';
@ -840,9 +794,7 @@ sub update_hostmask_data {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub get_nickserv_accounts_for_hostmask { sub get_nickserv_accounts_for_hostmask($self, $hostmask) {
my ($self, $hostmask) = @_;
my $nickservs = eval { my $nickservs = eval {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Hostmasks, Nickserv WHERE nickserv.id = hostmasks.id AND hostmasks.hostmask = ?'); my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Hostmasks, Nickserv WHERE nickserv.id = hostmasks.id AND hostmasks.hostmask = ?');
$sth->execute($hostmask); $sth->execute($hostmask);
@ -853,9 +805,7 @@ sub get_nickserv_accounts_for_hostmask {
return map { $_->[0] } @$nickservs; return map { $_->[0] } @$nickservs;
} }
sub get_gecos_for_hostmask { sub get_gecos_for_hostmask($self, $hostmask) {
my ($self, $hostmask) = @_;
my $gecos = eval { my $gecos = eval {
my $sth = $self->{dbh}->prepare('SELECT gecos FROM Hostmasks, Gecos WHERE gecos.id = hostmasks.id AND hostmasks.hostmask = ?'); my $sth = $self->{dbh}->prepare('SELECT gecos FROM Hostmasks, Gecos WHERE gecos.id = hostmasks.id AND hostmasks.hostmask = ?');
$sth->execute($hostmask); $sth->execute($hostmask);
@ -866,9 +816,7 @@ sub get_gecos_for_hostmask {
return map { $_->[0] } @$gecos; return map { $_->[0] } @$gecos;
} }
sub get_hostmasks_for_channel { sub get_hostmasks_for_channel($self, $channel) {
my ($self, $channel) = @_;
my $hostmasks = eval { my $hostmasks = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmasks.id, hostmask FROM Hostmasks, Channels WHERE channels.id = hostmasks.id AND channel = ?'); my $sth = $self->{dbh}->prepare('SELECT hostmasks.id, hostmask FROM Hostmasks, Channels WHERE channels.id = hostmasks.id AND channel = ?');
$sth->execute($channel); $sth->execute($channel);
@ -879,9 +827,7 @@ sub get_hostmasks_for_channel {
return $hostmasks; return $hostmasks;
} }
sub get_hostmasks_for_nickserv { sub get_hostmasks_for_nickserv($self, $nickserv) {
my ($self, $nickserv) = @_;
my $hostmasks = eval { my $hostmasks = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmasks.id, hostmask, nickserv FROM Hostmasks, Nickserv WHERE nickserv.id = hostmasks.id AND nickserv = ?'); my $sth = $self->{dbh}->prepare('SELECT hostmasks.id, hostmask, nickserv FROM Hostmasks, Nickserv WHERE nickserv.id = hostmasks.id AND nickserv = ?');
$sth->execute($nickserv); $sth->execute($nickserv);
@ -892,9 +838,7 @@ sub get_hostmasks_for_nickserv {
return $hostmasks; return $hostmasks;
} }
sub add_message { sub add_message($self, $id, $hostmask, $channel, $message) {
my ($self, $id, $hostmask, $channel, $message) = @_;
eval { eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Messages VALUES (?, ?, ?, ?, ?, ?)'); my $sth = $self->{dbh}->prepare('INSERT INTO Messages VALUES (?, ?, ?, ?, ?, ?)');
$sth->execute($id, $channel, $message->{msg}, $message->{timestamp}, $message->{mode}, $hostmask); $sth->execute($id, $channel, $message->{msg}, $message->{timestamp}, $message->{mode}, $hostmask);
@ -907,11 +851,7 @@ sub add_message {
$self->update_hostmask_data($hostmask, { last_seen => $message->{timestamp }}); $self->update_hostmask_data($hostmask, { last_seen => $message->{timestamp }});
} }
sub get_recent_messages { sub get_recent_messages($self, $id, $channel, $limit = 25, $mode = undef, $nick = undef) {
my ($self, $id, $channel, $limit, $mode, $nick) = @_;
$limit //= 25;
$channel = lc $channel; $channel = lc $channel;
my $mode_query = ''; my $mode_query = '';
@ -962,12 +902,7 @@ sub get_recent_messages {
return $messages; return $messages;
} }
sub get_recent_messages_from_channel { sub get_recent_messages_from_channel($self, $channel, $limit = 25, $mode = undef, $direction = 'ASC') {
my ($self, $channel, $limit, $mode, $direction) = @_;
$limit //= 25;
$direction //= 'ASC';
$channel = lc $channel; $channel = lc $channel;
my $mode_query = ''; my $mode_query = '';
@ -983,9 +918,7 @@ sub get_recent_messages_from_channel {
return $messages; return $messages;
} }
sub get_message_context { sub get_message_context($self, $message, $before = undef, $after = undef, $count = undef, $text = undef, $context_id = undef, $context_nick = undef) {
my ($self, $message, $before, $after, $count, $text, $context_id, $context_nick) = @_;
my %seen_id; my %seen_id;
my $ids = ''; my $ids = '';
@ -1079,9 +1012,7 @@ sub get_message_context {
return \@messages; return \@messages;
} }
sub recall_message_by_count { sub recall_message_by_count($self, $id, $channel, $count, $ignore_command = undef, $use_aliases = undef) {
my ($self, $id, $channel, $count, $ignore_command, $use_aliases) = @_;
my $messages = eval { my $messages = eval {
my $sql = 'SELECT * FROM Messages WHERE '; my $sql = 'SELECT * FROM Messages WHERE ';
@ -1141,9 +1072,7 @@ sub recall_message_by_count {
return $messages->[0]; return $messages->[0];
} }
sub recall_message_by_text { sub recall_message_by_text($self, $id, $channel, $text, $ignore_command = undef, $use_aliases = undef) {
my ($self, $id, $channel, $text, $ignore_command, $use_aliases) = @_;
my $search = "%$text%"; my $search = "%$text%";
$search =~ s/(?<!\\)\.?\*/%/g; $search =~ s/(?<!\\)\.?\*/%/g;
$search =~ s/(?<!\\)\?/_/g; $search =~ s/(?<!\\)\?/_/g;
@ -1212,9 +1141,7 @@ sub recall_message_by_text {
return $messages->[0]; return $messages->[0];
} }
sub get_random_message { sub get_random_message($self, $id, $channel, $use_aliases = undef) {
my ($self, $id, $channel, $use_aliases) = @_;
my $message = eval { my $message = eval {
my $sql = 'SELECT * FROM Messages WHERE channel = ? AND mode = ? '; my $sql = 'SELECT * FROM Messages WHERE channel = ? AND mode = ? ';
@ -1266,9 +1193,7 @@ sub get_random_message {
return $message; return $message;
} }
sub get_max_messages { sub get_max_messages($self, $id, $channel, $use_aliases = undef) {
my ($self, $id, $channel, $use_aliases) = @_;
my $count = eval { my $count = eval {
my $sql = 'SELECT COUNT(*) FROM Messages WHERE channel = ? AND '; my $sql = 'SELECT COUNT(*) FROM Messages WHERE channel = ? AND ';
@ -1313,9 +1238,7 @@ sub get_max_messages {
return $count; return $count;
} }
sub create_channel { sub create_channel($self, $id, $channel) {
my ($self, $id, $channel) = @_;
eval { eval {
my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Channels VALUES (?, ?, 0, 0, 0, 0, 0, 0, 0, 0)'); my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Channels VALUES (?, ?, 0, 0, 0, 0, 0, 0, 0, 0)');
my $rv = $sth->execute($id, $channel); my $rv = $sth->execute($id, $channel);
@ -1324,9 +1247,7 @@ sub create_channel {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub get_channels { sub get_channels($self, $id) {
my ($self, $id) = @_;
my $channels = eval { my $channels = eval {
my $sth = $self->{dbh}->prepare('SELECT channel FROM Channels WHERE id = ?'); my $sth = $self->{dbh}->prepare('SELECT channel FROM Channels WHERE id = ?');
$sth->execute($id); $sth->execute($id);
@ -1336,9 +1257,7 @@ sub get_channels {
return map { $_->[0] } @$channels; return map { $_->[0] } @$channels;
} }
sub get_channel_data { sub get_channel_data($self, $id, $channel, @columns) {
my ($self, $id, $channel, @columns) = @_;
$self->create_channel($id, $channel); $self->create_channel($id, $channel);
my $channel_data = eval { my $channel_data = eval {
@ -1362,9 +1281,7 @@ sub get_channel_data {
return $channel_data; return $channel_data;
} }
sub update_channel_data { sub update_channel_data($self, $id, $channel, $data) {
my ($self, $id, $channel, $data) = @_;
$self->create_channel($id, $channel); $self->create_channel($id, $channel);
eval { eval {
@ -1391,9 +1308,7 @@ sub update_channel_data {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub get_channel_datas_where_last_offense_older_than { sub get_channel_datas_where_last_offense_older_than($self, $timestamp) {
my ($self, $timestamp) = @_;
my $channel_datas = eval { my $channel_datas = eval {
my $sth = $self->{dbh}->prepare('SELECT id, channel, offenses, last_offense, unbanmes FROM Channels WHERE last_offense > 0 AND last_offense <= ?'); my $sth = $self->{dbh}->prepare('SELECT id, channel, offenses, last_offense, unbanmes FROM Channels WHERE last_offense > 0 AND last_offense <= ?');
$sth->execute($timestamp); $sth->execute($timestamp);
@ -1403,9 +1318,7 @@ sub get_channel_datas_where_last_offense_older_than {
return $channel_datas; return $channel_datas;
} }
sub get_channel_datas_with_enter_abuses { sub get_channel_datas_with_enter_abuses($self) {
my ($self) = @_;
my $channel_datas = eval { my $channel_datas = eval {
my $sth = $self->{dbh}->prepare('SELECT id, channel, enter_abuses, last_offense FROM Channels WHERE enter_abuses > 0'); my $sth = $self->{dbh}->prepare('SELECT id, channel, enter_abuses, last_offense FROM Channels WHERE enter_abuses > 0');
$sth->execute(); $sth->execute();
@ -1415,11 +1328,7 @@ sub get_channel_datas_with_enter_abuses {
return $channel_datas; return $channel_datas;
} }
sub devalidate_channel { sub devalidate_channel($self, $id, $channel, $mode = 0) {
my ($self, $id, $channel, $mode) = @_;
$mode = 0 if not defined $mode;
eval { eval {
my $sth = $self->{dbh}->prepare("UPDATE Channels SET validated = ? WHERE id = ? AND channel = ?"); my $sth = $self->{dbh}->prepare("UPDATE Channels SET validated = ? WHERE id = ? AND channel = ?");
$sth->execute($mode, $id, $channel); $sth->execute($mode, $id, $channel);
@ -1428,11 +1337,7 @@ sub devalidate_channel {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub devalidate_all_channels { sub devalidate_all_channels($self, $id = undef, $mode = 0) {
my ($self, $id, $mode) = @_;
$mode = 0 if not defined $mode;
my $where = ''; my $where = '';
$where = 'WHERE id = ?' if defined $id; $where = 'WHERE id = ?' if defined $id;
@ -1446,9 +1351,7 @@ sub devalidate_all_channels {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub link_aliases { sub link_aliases($self, $account, $hostmask = undef, $nickserv = undef) {
my ($self, $account, $hostmask, $nickserv) = @_;
my $debug_link = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_link'); my $debug_link = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_link');
$self->{pbot}->{logger}->log("Linking [$account][" . ($hostmask ? $hostmask : 'undef') . "][" . ($nickserv ? $nickserv : 'undef') . "]\n") if $debug_link >= 3; $self->{pbot}->{logger}->log("Linking [$account][" . ($hostmask ? $hostmask : 'undef') . "][" . ($nickserv ? $nickserv : 'undef') . "]\n") if $debug_link >= 3;
@ -1555,9 +1458,7 @@ sub link_aliases {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub link_alias { sub link_alias($self, $id, $alias, $type = undef, $force = undef) {
my ($self, $id, $alias, $type, $force) = @_;
my $debug_link = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_link'); my $debug_link = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_link');
$self->{pbot}->{logger} $self->{pbot}->{logger}
@ -1621,9 +1522,7 @@ sub link_alias {
return $ret; return $ret;
} }
sub unlink_alias { sub unlink_alias($self, $id, $alias) {
my ($self, $id, $alias) = @_;
my $ret = eval { my $ret = eval {
my $ret = 0; my $ret = 0;
my $sth = $self->{dbh}->prepare('DELETE FROM Aliases WHERE id = ? AND alias = ?'); my $sth = $self->{dbh}->prepare('DELETE FROM Aliases WHERE id = ? AND alias = ?');
@ -1647,9 +1546,7 @@ sub unlink_alias {
return $ret; return $ret;
} }
sub delete_hostmask { sub delete_hostmask($self, $id, $hostmask) {
my ($self, $id, $hostmask) = @_;
eval { eval {
$self->{dbh}->do('DELETE FROM Hostmasks WHERE id = ? AND hostmask = ?', undef, $id, $hostmask); $self->{dbh}->do('DELETE FROM Hostmasks WHERE id = ? AND hostmask = ?', undef, $id, $hostmask);
$self->{dbh}->commit; $self->{dbh}->commit;
@ -1664,9 +1561,7 @@ sub delete_hostmask {
return 1; return 1;
} }
sub delete_account { sub delete_account($self, $id) {
my ($self, $id) = @_;
$self->{dbh}->commit; $self->{dbh}->commit;
$self->{dbh}->begin_work; $self->{dbh}->begin_work;
@ -1694,9 +1589,7 @@ sub delete_account {
return $ret; return $ret;
} }
sub vacuum { sub vacuum($self) {
my $self = shift;
eval { $self->{dbh}->commit(); }; eval { $self->{dbh}->commit(); };
$self->{pbot}->{logger}->log("SQLite error $@ when committing $self->{new_entries} entries.\n") if $@; $self->{pbot}->{logger}->log("SQLite error $@ when committing $self->{new_entries} entries.\n") if $@;
@ -1707,9 +1600,7 @@ sub vacuum {
$self->{new_entries} = 0; $self->{new_entries} = 0;
} }
sub rebuild_aliases_table { sub rebuild_aliases_table($self) {
my $self = shift;
eval { eval {
$self->{dbh}->do('DELETE FROM Aliases'); $self->{dbh}->do('DELETE FROM Aliases');
$self->vacuum; $self->vacuum;
@ -1737,8 +1628,7 @@ sub rebuild_aliases_table {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@; $self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
} }
sub get_also_known_as { sub get_also_known_as($self, $nick, $dont_use_aliases_table = undef) {
my ($self, $nick, $dont_use_aliases_table) = @_;
my $debug = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_aka'); my $debug = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_aka');
$self->{pbot}->{logger}->log("[AKA] Checking nick $nick\n") if $debug; $self->{pbot}->{logger}->log("[AKA] Checking nick $nick\n") if $debug;
@ -1946,11 +1836,7 @@ sub get_also_known_as {
return %akas; return %akas;
} }
sub get_ancestor_id { sub get_ancestor_id($self, $id = 0) {
my ($self, $id) = @_;
$id = 0 if not defined $id;
my $ancestor = eval { my $ancestor = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Aliases WHERE alias = ? ORDER BY id LIMIT 1'); my $sth = $self->{dbh}->prepare('SELECT id FROM Aliases WHERE alias = ? ORDER BY id LIMIT 1');
$sth->execute($id); $sth->execute($id);
@ -1966,9 +1852,7 @@ sub get_ancestor_id {
# End of public API, the remaining are internal support routines for this module # End of public API, the remaining are internal support routines for this module
sub get_new_account_id { sub get_new_account_id($self) {
my $self = shift;
my $id = eval { my $id = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Accounts ORDER BY id DESC LIMIT 1'); my $sth = $self->{dbh}->prepare('SELECT id FROM Accounts ORDER BY id DESC LIMIT 1');
$sth->execute(); $sth->execute();
@ -1980,9 +1864,7 @@ sub get_new_account_id {
return ++$id; return ++$id;
} }
sub get_message_account_id { sub get_message_account_id($self, $mask) {
my ($self, $mask) = @_;
my $id = eval { my $id = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Hostmasks WHERE hostmask == ?'); my $sth = $self->{dbh}->prepare('SELECT id FROM Hostmasks WHERE hostmask == ?');
$sth->execute($mask); $sth->execute($mask);
@ -1994,9 +1876,7 @@ sub get_message_account_id {
return $id; return $id;
} }
sub commit_message_history { sub commit_message_history($self) {
my ($self) = @_;
return if not $self->{dbh}; return if not $self->{dbh};
return if $self->{pbot}->{child}; # don't commit() as child of fork() return if $self->{pbot}->{child}; # don't commit() as child of fork()

55
lib/PBot/Core/NickList.pm
View File

@ -15,9 +15,7 @@ use PBot::Imports;
use Text::Levenshtein::XS qw/distance/; use Text::Levenshtein::XS qw/distance/;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# nicklist hashtable # nicklist hashtable
$self->{nicklist} = {}; $self->{nicklist} = {};
@ -25,9 +23,7 @@ sub initialize {
$self->{pbot}->{registry}->add_default('text', 'nicklist', 'debug', '0'); $self->{pbot}->{registry}->add_default('text', 'nicklist', 'debug', '0');
} }
sub update_timestamp { sub update_timestamp($self, $channel, $nick) {
my ($self, $channel, $nick) = @_;
my $orig_nick = $nick; my $orig_nick = $nick;
$channel = lc $channel; $channel = lc $channel;
@ -40,14 +36,11 @@ sub update_timestamp {
$self->{nicklist}->{$channel}->{$nick}->{timestamp} = gettimeofday; $self->{nicklist}->{$channel}->{$nick}->{timestamp} = gettimeofday;
} }
sub remove_channel { sub remove_channel($self, $channel) {
my ($self, $channel) = @_;
delete $self->{nicklist}->{lc $channel}; delete $self->{nicklist}->{lc $channel};
} }
sub add_nick { sub add_nick($self, $channel, $nick) {
my ($self, $channel, $nick) = @_;
if (not exists $self->{nicklist}->{lc $channel}->{lc $nick}) { if (not exists $self->{nicklist}->{lc $channel}->{lc $nick}) {
if ($self->{pbot}->{registry}->get_value('nicklist', 'debug')) { if ($self->{pbot}->{registry}->get_value('nicklist', 'debug')) {
$self->{pbot}->{logger}->log("Adding nick '$nick' to channel '$channel'\n"); $self->{pbot}->{logger}->log("Adding nick '$nick' to channel '$channel'\n");
@ -56,18 +49,14 @@ sub add_nick {
} }
} }
sub remove_nick { sub remove_nick($self, $channel, $nick) {
my ($self, $channel, $nick) = @_;
if ($self->{pbot}->{registry}->get_value('nicklist', 'debug')) { if ($self->{pbot}->{registry}->get_value('nicklist', 'debug')) {
$self->{pbot}->{logger}->log("Removing nick '$nick' from channel '$channel'\n"); $self->{pbot}->{logger}->log("Removing nick '$nick' from channel '$channel'\n");
} }
delete $self->{nicklist}->{lc $channel}->{lc $nick}; delete $self->{nicklist}->{lc $channel}->{lc $nick};
} }
sub get_channels { sub get_channels($self, $nick) {
my ($self, $nick) = @_;
$nick = lc $nick; $nick = lc $nick;
my @channels; my @channels;
@ -81,9 +70,7 @@ sub get_channels {
return \@channels; return \@channels;
} }
sub get_nicks { sub get_nicks($self, $channel) {
my ($self, $channel) = @_;
$channel = lc $channel; $channel = lc $channel;
my @nicks; my @nicks;
@ -97,9 +84,7 @@ sub get_nicks {
return @nicks; return @nicks;
} }
sub set_meta { sub set_meta($self, $channel, $nick, $key, $value) {
my ($self, $channel, $nick, $key, $value) = @_;
$channel = lc $channel; $channel = lc $channel;
$nick = lc $nick; $nick = lc $nick;
@ -130,9 +115,7 @@ sub set_meta {
return 1; return 1;
} }
sub delete_meta { sub delete_meta($self, $channel, $nick, $key) {
my ($self, $channel, $nick, $key) = @_;
$channel = lc $channel; $channel = lc $channel;
$nick = lc $nick; $nick = lc $nick;
@ -143,9 +126,7 @@ sub delete_meta {
return delete $self->{nicklist}->{$channel}->{$nick}->{$key}; return delete $self->{nicklist}->{$channel}->{$nick}->{$key};
} }
sub get_meta { sub get_meta($self, $channel, $nick, $key) {
my ($self, $channel, $nick, $key) = @_;
$channel = lc $channel; $channel = lc $channel;
$nick = lc $nick; $nick = lc $nick;
@ -156,9 +137,7 @@ sub get_meta {
return $self->{nicklist}->{$channel}->{$nick}->{$key}; return $self->{nicklist}->{$channel}->{$nick}->{$key};
} }
sub is_present_any_channel { sub is_present_any_channel($self, $nick) {
my ($self, $nick) = @_;
$nick = lc $nick; $nick = lc $nick;
foreach my $channel (keys %{$self->{nicklist}}) { foreach my $channel (keys %{$self->{nicklist}}) {
@ -170,9 +149,7 @@ sub is_present_any_channel {
return 0; return 0;
} }
sub is_present { sub is_present($self, $channel, $nick) {
my ($self, $channel, $nick) = @_;
$channel = lc $channel; $channel = lc $channel;
$nick = lc $nick; $nick = lc $nick;
@ -183,9 +160,7 @@ sub is_present {
} }
} }
sub is_present_similar { sub is_present_similar($self, $channel, $nick, $similarity = undef) {
my ($self, $channel, $nick, $similarity) = @_;
$channel = lc $channel; $channel = lc $channel;
$nick = lc $nick; $nick = lc $nick;
@ -228,9 +203,7 @@ sub is_present_similar {
return 0; return 0;
} }
sub random_nick { sub random_nick($self, $channel) {
my ($self, $channel) = @_;
$channel = lc $channel; $channel = lc $channel;
if (exists $self->{nicklist}->{$channel}) { if (exists $self->{nicklist}->{$channel}) {

16
lib/PBot/Core/Plugins.pm
View File

@ -12,9 +12,7 @@ use PBot::Imports;
use File::Basename; use File::Basename;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# loaded plugins # loaded plugins
$self->{plugins} = {}; $self->{plugins} = {};
@ -22,9 +20,7 @@ sub initialize {
$self->autoload(%conf); $self->autoload(%conf);
} }
sub autoload { sub autoload($self, %conf) {
my ($self, %conf) = @_;
return if $self->{pbot}->{registry}->get_value('plugins', 'noautoload'); return if $self->{pbot}->{registry}->get_value('plugins', 'noautoload');
my $data_dir = $self->{pbot}->{registry}->get_value('general', 'data_dir'); my $data_dir = $self->{pbot}->{registry}->get_value('general', 'data_dir');
@ -63,9 +59,7 @@ sub autoload {
$self->{pbot}->{logger}->log("$plugin_count plugin" . ($plugin_count == 1 ? '' : 's') . " loaded.\n"); $self->{pbot}->{logger}->log("$plugin_count plugin" . ($plugin_count == 1 ? '' : 's') . " loaded.\n");
} }
sub load { sub load($self, $plugin, %conf) {
my ($self, $plugin, %conf) = @_;
$self->unload($plugin); $self->unload($plugin);
return if $self->{pbot}->{registry}->get_value('plugins', 'disabled'); return if $self->{pbot}->{registry}->get_value('plugins', 'disabled');
@ -91,9 +85,7 @@ sub load {
return $ret; return $ret;
} }
sub unload { sub unload($self, $plugin) {
my ($self, $plugin) = @_;
if (exists $self->{plugins}->{$plugin}) { if (exists $self->{plugins}->{$plugin}) {
eval { eval {
$self->{plugins}->{$plugin}->unload; $self->{plugins}->{$plugin}->unload;

24
lib/PBot/Core/ProcessManager.pm
View File

@ -15,9 +15,7 @@ use Time::HiRes qw/gettimeofday/;
use POSIX qw/WNOHANG/; use POSIX qw/WNOHANG/;
use JSON; use JSON;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# hash of currently running bot-invoked processes # hash of currently running bot-invoked processes
$self->{processes} = {}; $self->{processes} = {};
@ -27,9 +25,7 @@ sub initialize {
}; };
} }
sub add_process { sub add_process($self, $pid, $context) {
my ($self, $pid, $context) = @_;
$context->{process_start} = gettimeofday; $context->{process_start} = gettimeofday;
$self->{processes}->{$pid} = $context; $self->{processes}->{$pid} = $context;
@ -37,9 +33,7 @@ sub add_process {
$self->{pbot}->{logger}->log("Starting process $pid: $context->{commands}->[0]\n"); $self->{pbot}->{logger}->log("Starting process $pid: $context->{commands}->[0]\n");
} }
sub remove_process { sub remove_process($self, $pid) {
my ($self, $pid) = @_;
if (exists $self->{processes}->{$pid}) { if (exists $self->{processes}->{$pid}) {
my $command = $self->{processes}->{$pid}->{commands}->[0]; my $command = $self->{processes}->{$pid}->{commands}->[0];
@ -54,11 +48,7 @@ sub remove_process {
} }
} }
sub execute_process { sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref = undef) {
my ($self, $context, $subref, $timeout, $reader_subref) = @_;
$timeout //= 30; # default timeout 30 seconds
# ensure contextual command history list is available for add_process() # ensure contextual command history list is available for add_process()
if (not exists $context->{commands}) { if (not exists $context->{commands}) {
$context->{commands} = [$context->{command}]; $context->{commands} = [$context->{command}];
@ -110,7 +100,7 @@ sub execute_process {
# execute the provided subroutine, results are stored in $context # execute the provided subroutine, results are stored in $context
eval { eval {
local $SIG{ALRM} = sub { die "Process `$context->{commands}->[0]` timed-out\n" }; local $SIG{ALRM} = sub { die "Process `$context->{commands}->[0]` timed-out\n" };
alarm $timeout; alarm ($timeout // 30);
$subref->($context); $subref->($context);
alarm 0; alarm 0;
}; };
@ -152,9 +142,7 @@ sub execute_process {
} }
} }
sub process_pipe_reader { sub process_pipe_reader($self, $pid, $buf) {
my ($self, $pid, $buf) = @_;
# retrieve context object from child # retrieve context object from child
my $context = decode_json $buf or do { my $context = decode_json $buf or do {
$self->{pbot}->{logger}->log("Failed to decode bad json: [$buf]\n"); $self->{pbot}->{logger}->log("Failed to decode bad json: [$buf]\n");

4
lib/PBot/Core/Refresher.pm
View File

@ -14,9 +14,7 @@ use PBot::Imports;
use Module::Refresh; use Module::Refresh;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{refresher} = Module::Refresh->new; $self->{refresher} = Module::Refresh->new;
} }

29
lib/PBot/Core/Registerable.pm
View File

@ -9,8 +9,7 @@ package PBot::Core::Registerable;
use PBot::Imports; use PBot::Imports;
sub new { sub new($class, %args) {
my ($class, %args) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot}; Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot}; $self->{pbot} = delete $args{pbot};
@ -18,52 +17,40 @@ sub new {
return $self; return $self;
} }
sub initialize { sub initialize($self, %args) {
my $self = shift;
$self->{handlers} = []; $self->{handlers} = [];
} }
sub execute_all { sub execute_all($self) {
my $self = shift;
foreach my $func (@{$self->{handlers}}) { foreach my $func (@{$self->{handlers}}) {
$func->{subref}->(@_); $func->{subref}->(@_);
} }
} }
sub execute { sub execute($self, $ref) {
my $self = shift;
my $ref = shift;
Carp::croak("Missing reference parameter to Registerable::execute") if not defined $ref;
foreach my $func (@{$self->{handlers}}) { foreach my $func (@{$self->{handlers}}) {
if ($ref == $func || $ref == $func->{subref}) { return $func->{subref}->(@_); } if ($ref == $func || $ref == $func->{subref}) { return $func->{subref}->(@_); }
} }
return undef; return undef;
} }
sub register { sub register($self, $subref) {
my ($self, $subref) = @_;
Carp::croak("Must pass subroutine reference to register()") if not defined $subref;
my $ref = {subref => $subref}; my $ref = {subref => $subref};
push @{$self->{handlers}}, $ref; push @{$self->{handlers}}, $ref;
return $ref; return $ref;
} }
sub register_front { sub register_front($self, $subref) {
my ($self, $subref) = @_;
Carp::croak("Must pass subroutine reference to register_front()") if not defined $subref;
my $ref = {subref => $subref}; my $ref = {subref => $subref};
unshift @{$self->{handlers}}, $ref; unshift @{$self->{handlers}}, $ref;
return $ref; return $ref;
} }
sub unregister { sub unregister($self, $ref) {
my ($self, $ref) = @_;
Carp::croak("Must pass reference to unregister()") if not defined $ref;
@{$self->{handlers}} = grep { $_ != $ref } @{$self->{handlers}}; @{$self->{handlers}} = grep { $_ != $ref } @{$self->{handlers}};
} }
sub unregister_all { sub unregister_all($self) {
my ($self) = @_;
$self->{handlers} = []; $self->{handlers} = [];
} }

64
lib/PBot/Core/Registry.pm
View File

@ -11,9 +11,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# ensure we have a registry filename # ensure we have a registry filename
my $filename = $conf{filename} // Carp::croak("Missing filename configuration item in " . __FILE__); my $filename = $conf{filename} // Carp::croak("Missing filename configuration item in " . __FILE__);
@ -94,9 +92,7 @@ sub initialize {
# registry triggers fire when value changes # registry triggers fire when value changes
sub trigger_irc_debug { sub trigger_irc_debug($self, $section, $item, $newvalue) {
my ($self, $section, $item, $newvalue) = @_;
$self->{pbot}->{irc}->debug($newvalue); $self->{pbot}->{irc}->debug($newvalue);
if ($self->{pbot}->{conn}) { if ($self->{pbot}->{conn}) {
@ -104,9 +100,7 @@ sub trigger_irc_debug {
} }
} }
sub trigger_change_botnick { sub trigger_change_botnick($self, $section, $item, $newvalue) {
my ($self, $section, $item, $newvalue) = @_;
if ($self->{pbot}->{conn}) { if ($self->{pbot}->{conn}) {
$self->{pbot}->{conn}->nick($newvalue) $self->{pbot}->{conn}->nick($newvalue)
} }
@ -114,9 +108,7 @@ sub trigger_change_botnick {
# registry api # registry api
sub load { sub load($self) {
my $self = shift;
# load registry from file # load registry from file
$self->{storage}->load; $self->{storage}->load;
@ -128,21 +120,15 @@ sub load {
} }
} }
sub save { sub save($self) {
my $self = shift;
$self->{storage}->save; $self->{storage}->save;
} }
sub add_default { sub add_default($self, $type, $section, $item, $value) {
my ($self, $type, $section, $item, $value) = @_;
$self->add($type, $section, $item, $value, 1); $self->add($type, $section, $item, $value, 1);
} }
sub add { sub add($self, $type, $section, $item, $value, $is_default = 0) {
my ($self, $type, $section, $item, $value, $is_default) = @_;
$type = lc $type; $type = lc $type;
if (not $self->{storage}->exists($section, $item)) { if (not $self->{storage}->exists($section, $item)) {
@ -177,21 +163,15 @@ sub add {
} }
} }
sub remove { sub remove($self, $section, $item) {
my ($self, $section, $item) = @_;
$self->{storage}->remove($section, $item); $self->{storage}->remove($section, $item);
} }
sub set_default { sub set_default($self, $section, $item, $key, $value) {
my ($self, $section, $item, $key, $value) = @_;
$self->set($section, $item, $key, $value, 1); $self->set($section, $item, $key, $value, 1);
} }
sub set { sub set($self, $section, $item, $key = undef, $value = undef, $is_default = 0, $dont_save = 0) {
my ($self, $section, $item, $key, $value, $is_default, $dont_save) = @_;
$key = lc $key if defined $key; $key = lc $key if defined $key;
if ($is_default && $self->{storage}->exists($section, $item, $key)) { if ($is_default && $self->{storage}->exists($section, $item, $key)) {
@ -217,17 +197,12 @@ sub set {
return $result; return $result;
} }
sub unset { sub unset($self, $section, $item, $key = undef) {
my ($self, $section, $item, $key) = @_;
$key = lc $key if defined $key; $key = lc $key if defined $key;
return $self->{storage}->unset($section, $item, $key); return $self->{storage}->unset($section, $item, $key);
} }
sub get_value { sub get_value($self, $section, $item, $as_text = undef, $context = undef) {
my ($self, $section, $item, $as_text, $context) = @_;
$section = lc $section; $section = lc $section;
$item = lc $item; $item = lc $item;
@ -252,9 +227,7 @@ sub get_value {
return undef; return undef;
} }
sub get_array_value { sub get_array_value($self, $section, $item, $index, $context = undef) {
my ($self, $section, $item, $index, $context) = @_;
$section = lc $section; $section = lc $section;
$item = lc $item; $item = lc $item;
@ -280,21 +253,18 @@ sub get_array_value {
return undef; return undef;
} }
sub add_trigger { sub add_trigger($self, $section, $item, $subref) {
my ($self, $section, $item, $subref) = @_;
$self->{triggers}->{lc $section}->{lc $item} = $subref; $self->{triggers}->{lc $section}->{lc $item} = $subref;
} }
sub process_trigger { sub process_trigger($self, @args) {
my $self = shift; # shift $self off of the top of @_ my ($section, $item) = @args;
my ($section, $item) = @_; # but leave $section, $item and anything else (i.e. $value) in @_
$section = lc $section; $section = lc $section;
$item = lc $item; $item = lc $item;
if (exists $self->{triggers}->{$section} and exists $self->{triggers}->{$section}->{$item}) { if (exists $self->{triggers}->{$section} and exists $self->{triggers}->{$section}->{$item}) {
return &{$self->{triggers}->{$section}->{$item}}(@_); # $section, $item, $value, etc in @_ return &{$self->{triggers}->{$section}->{$item}}(@args);
} }
return undef; return undef;

12
lib/PBot/Core/SelectHandler.pm
View File

@ -15,9 +15,7 @@ sub initialize {
# nothing to initialize # nothing to initialize
} }
sub add_reader { sub add_reader($self, $handle, $subref) {
my ($self, $handle, $subref) = @_;
# add file handle to PBot::Core::IRC's select loop # add file handle to PBot::Core::IRC's select loop
$self->{pbot}->{irc}->addfh($handle, sub { $self->on_select_read($handle, $subref) }, 'r'); $self->{pbot}->{irc}->addfh($handle, sub { $self->on_select_read($handle, $subref) }, 'r');
@ -25,9 +23,7 @@ sub add_reader {
$self->{buffers}->{$handle} = ''; $self->{buffers}->{$handle} = '';
} }
sub remove_reader { sub remove_reader($self, $handle) {
my ($self, $handle) = @_;
# remove file handle from PBot::Core::IRC's select loop # remove file handle from PBot::Core::IRC's select loop
$self->{pbot}->{irc}->removefh($handle); $self->{pbot}->{irc}->removefh($handle);
@ -35,9 +31,7 @@ sub remove_reader {
delete $self->{buffers}->{$handle}; delete $self->{buffers}->{$handle};
} }
sub on_select_read { sub on_select_read($self, $handle, $subref) {
my ($self, $handle, $subref) = @_;
# maximum read length # maximum read length
my $length = 8192; my $length = 8192;

8
lib/PBot/Core/StdinReader.pm
View File

@ -20,9 +20,7 @@ use POSIX qw(tcgetpgrp getpgrp); # to check whether process is in background or
use Encode; use Encode;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# create stdin bot-admin account for bot # create stdin bot-admin account for bot
my $user = $self->{pbot}->{users}->find_user('.*', '*!stdin@pbot'); my $user = $self->{pbot}->{users}->find_user('.*', '*!stdin@pbot');
@ -47,9 +45,7 @@ sub initialize {
} }
} }
sub stdin_reader { sub stdin_reader($self, $input) {
my ($self, $input) = @_;
# make sure we're in the foreground first # make sure we're in the foreground first
$self->{foreground} = (tcgetpgrp($self->{tty_fd}) == getpgrp()) ? 1 : 0; $self->{foreground} = (tcgetpgrp($self->{tty_fd}) == getpgrp()) ? 1 : 0;
return if not $self->{foreground}; return if not $self->{foreground};

54
lib/PBot/Core/Storage/DualIndexHashObject.pm
View File

@ -22,8 +22,7 @@ use PBot::Imports;
use Text::Levenshtein::XS qw(distance); use Text::Levenshtein::XS qw(distance);
use JSON; use JSON;
sub new { sub new($class, %args) {
my ($class, %args) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot}; Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot}; $self->{pbot} = delete $args{pbot};
@ -31,16 +30,14 @@ sub new {
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{name} = $conf{name} // 'unnamed'; $self->{name} = $conf{name} // 'unnamed';
$self->{filename} = $conf{filename} // Carp::carp("Missing filename to DualIndexHashObject, will not be able to save to or load from file."); $self->{filename} = $conf{filename} // Carp::carp("Missing filename to DualIndexHashObject, will not be able to save to or load from file.");
$self->{save_queue_timeout} = $conf{save_queue_timeout} // 0; $self->{save_queue_timeout} = $conf{save_queue_timeout} // 0;
$self->{hash} = {}; $self->{hash} = {};
} }
sub load { sub load($self, $filename = undef) {
my ($self, $filename) = @_;
$filename = $self->{filename} if not defined $filename; $filename = $self->{filename} if not defined $filename;
if (not defined $filename) { if (not defined $filename) {
@ -96,10 +93,9 @@ sub load {
} }
} }
sub save { sub save($self, @args) {
my $self = shift;
my $filename; my $filename;
if (@_) { $filename = shift; } if (@args) { $filename = shift @args; }
else { $filename = $self->{filename}; } else { $filename = $self->{filename}; }
if (not defined $filename) { if (not defined $filename) {
@ -137,18 +133,14 @@ sub save {
} }
} }
sub clear { sub clear($self) {
my $self = shift;
$self->{hash} = {}; $self->{hash} = {};
} }
sub levenshtein_matches { sub levenshtein_matches($self, $primary_index, $secondary_index, $distance = 0.60, $strictnamespace = 0) {
my ($self, $primary_index, $secondary_index, $distance, $strictnamespace) = @_;
my $comma = ''; my $comma = '';
my $result = ""; my $result = "";
$distance = 0.60 if not defined $distance;
$primary_index = '.*' if not defined $primary_index; $primary_index = '.*' if not defined $primary_index;
if (not $secondary_index) { if (not $secondary_index) {
@ -205,8 +197,7 @@ sub levenshtein_matches {
return $result; return $result;
} }
sub set { sub set($self, $primary_index, $secondary_index, $key = undef, $value = undef, $dont_save = 0) {
my ($self, $primary_index, $secondary_index, $key, $value, $dont_save) = @_;
my $lc_primary_index = lc $primary_index; my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index; my $lc_secondary_index = lc $secondary_index;
@ -241,8 +232,9 @@ sub set {
return $result; return $result;
} }
if (not defined $value) { $value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key}; } if (not defined $value) {
else { $value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key};
} else {
$self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key} = $value; $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key} = $value;
$self->save unless $dont_save; $self->save unless $dont_save;
} }
@ -250,8 +242,7 @@ sub set {
return "[$name1] $name2: $key " . (defined $value ? "set to $value" : "is not set."); return "[$name1] $name2: $key " . (defined $value ? "set to $value" : "is not set.");
} }
sub unset { sub unset($self, $primary_index, $secondary_index, $key) {
my ($self, $primary_index, $secondary_index, $key) = @_;
my $lc_primary_index = lc $primary_index; my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index; my $lc_secondary_index = lc $secondary_index;
@ -282,8 +273,7 @@ sub unset {
$self->save; $self->save;
} }
sub exists { sub exists($self, $primary_index = undef, $secondary_index = undef, $data_index = undef) {
my ($self, $primary_index, $secondary_index, $data_index) = @_;
return 0 if not defined $primary_index; return 0 if not defined $primary_index;
$primary_index = lc $primary_index; $primary_index = lc $primary_index;
return 0 if not exists $self->{hash}->{$primary_index}; return 0 if not exists $self->{hash}->{$primary_index};
@ -294,9 +284,7 @@ sub exists {
return exists $self->{hash}->{$primary_index}->{$secondary_index}->{$data_index}; return exists $self->{hash}->{$primary_index}->{$secondary_index}->{$data_index};
} }
sub get_key_name { sub get_key_name($self, $primary_index, $secondary_index = undef) {
my ($self, $primary_index, $secondary_index) = @_;
my $lc_primary_index = lc $primary_index; my $lc_primary_index = lc $primary_index;
return $lc_primary_index if not exists $self->{hash}->{$lc_primary_index}; return $lc_primary_index if not exists $self->{hash}->{$lc_primary_index};
@ -320,8 +308,7 @@ sub get_key_name {
} }
} }
sub get_keys { sub get_keys($self, $primary_index = undef, $secondary_index = undef) {
my ($self, $primary_index, $secondary_index) = @_;
return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $primary_index; return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $primary_index;
my $lc_primary_index = lc $primary_index; my $lc_primary_index = lc $primary_index;
@ -339,9 +326,8 @@ sub get_keys {
return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $primary_index}->{lc $secondary_index}}; return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $primary_index}->{lc $secondary_index}};
} }
sub get_data { sub get_data($self, $primary_index, $secondary_index = undef, $data_index = undef) {
my ($self, $primary_index, $secondary_index, $data_index) = @_; $primary_index = lc $primary_index;
$primary_index = lc $primary_index if defined $primary_index;
$secondary_index = lc $secondary_index if defined $secondary_index; $secondary_index = lc $secondary_index if defined $secondary_index;
return undef if not exists $self->{hash}->{$primary_index}; return undef if not exists $self->{hash}->{$primary_index};
return $self->{hash}->{$primary_index} if not defined $secondary_index; return $self->{hash}->{$primary_index} if not defined $secondary_index;
@ -349,8 +335,7 @@ sub get_data {
return $self->{hash}->{$primary_index}->{$secondary_index}->{$data_index}; return $self->{hash}->{$primary_index}->{$secondary_index}->{$data_index};
} }
sub add { sub add($self, $primary_index, $secondary_index, $data, $dont_save = 0, $quiet = 0) {
my ($self, $primary_index, $secondary_index, $data, $dont_save, $quiet) = @_;
my $lc_primary_index = lc $primary_index; my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index; my $lc_secondary_index = lc $secondary_index;
@ -386,8 +371,7 @@ sub add {
return "$self->{name}: [$name1]: $name2 added."; return "$self->{name}: [$name1]: $name2 added.";
} }
sub remove { sub remove($self, $primary_index, $secondary_index = undef, $data_index = undef, $dont_save = 0) {
my ($self, $primary_index, $secondary_index, $data_index, $dont_save) = @_;
my $lc_primary_index = lc $primary_index; my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index if defined $secondary_index; my $lc_secondary_index = lc $secondary_index if defined $secondary_index;

97
lib/PBot/Core/Storage/DualIndexSQLiteObject.pm
View File

@ -26,8 +26,7 @@ use PBot::Core::Utils::SQLiteLoggerLayer;
use DBI; use DBI;
use Text::Levenshtein::XS qw(distance); use Text::Levenshtein::XS qw(distance);
sub new { sub new($class, %args) {
my ($class, %args) = @_;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot}; Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
my $self = bless {}, $class; my $self = bless {}, $class;
$self->{pbot} = delete $args{pbot}; $self->{pbot} = delete $args{pbot};
@ -35,9 +34,7 @@ sub new {
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{name} = $conf{name} // 'Dual Index SQLite object'; $self->{name} = $conf{name} // 'Dual Index SQLite object';
$self->{filename} = $conf{filename} // Carp::croak("Missing filename in " . __FILE__); $self->{filename} = $conf{filename} // Carp::croak("Missing filename in " . __FILE__);
@ -54,15 +51,12 @@ sub initialize {
$self->begin; $self->begin;
} }
sub sqlite_debug_trigger { sub sqlite_debug_trigger($self, $section, $item, $newvalue) {
my ($self, $section, $item, $newvalue) = @_;
return if not defined $self->{dbh}; return if not defined $self->{dbh};
$self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")); $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue"));
} }
sub begin { sub begin($self) {
my ($self) = @_;
$self->{pbot}->{logger}->log("Opening $self->{name} database ($self->{filename})\n"); $self->{pbot}->{logger}->log("Opening $self->{name} database ($self->{filename})\n");
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", undef, undef, $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", undef, undef,
@ -80,9 +74,7 @@ sub begin {
} }
} }
sub end { sub end($self) {
my ($self) = @_;
$self->{pbot}->{logger}->log("Closing $self->{name} database ($self->{filename})\n"); $self->{pbot}->{logger}->log("Closing $self->{name} database ($self->{filename})\n");
if (defined $self->{dbh}) { if (defined $self->{dbh}) {
@ -95,14 +87,12 @@ sub end {
$self->{pbot}->{event_queue}->dequeue("Trim $self->{name} cache"); $self->{pbot}->{event_queue}->dequeue("Trim $self->{name} cache");
} }
sub load { sub load ($self) {
my ($self) = @_;
$self->create_database; $self->create_database;
$self->create_cache; $self->create_cache;
} }
sub save { sub save($self) {
my ($self) = @_;
return if not $self->{dbh}; return if not $self->{dbh};
eval { $self->{dbh}->commit }; eval { $self->{dbh}->commit };
@ -112,9 +102,7 @@ sub save {
} }
} }
sub create_database { sub create_database($self) {
my ($self) = @_;
eval { eval {
$self->{dbh}->do(<<SQL); $self->{dbh}->do(<<SQL);
CREATE TABLE IF NOT EXISTS Stuff ( CREATE TABLE IF NOT EXISTS Stuff (
@ -129,9 +117,7 @@ SQL
$self->{pbot}->{logger}->log("Error creating $self->{name} databse: $@") if $@; $self->{pbot}->{logger}->log("Error creating $self->{name} databse: $@") if $@;
} }
sub create_cache { sub create_cache($self) {
my ($self) = @_;
$self->{cache} = {}; $self->{cache} = {};
my ($index1_count, $index2_count) = (0, 0); my ($index1_count, $index2_count) = (0, 0);
@ -161,9 +147,7 @@ sub create_cache {
$self->{pbot}->{logger}->log("Cached $index2_count $self->{name} objects in $index1_count groups.\n"); $self->{pbot}->{logger}->log("Cached $index2_count $self->{name} objects in $index1_count groups.\n");
} }
sub cache_remove { sub cache_remove($self, $index1, $index2 = undef) {
my ($self, $index1, $index2) = @_;
if (not defined $index2) { if (not defined $index2) {
# remove index1 # remove index1
delete $self->{cache}->{$index1}; delete $self->{cache}->{$index1};
@ -181,9 +165,7 @@ sub cache_remove {
} }
} }
sub enqueue_decache { sub enqueue_decache($self, $index1, $index2) {
my ($self, $index1, $index2) = @_;
my $timeout = $self->{pbot}->{registry}->get_value('dualindexsqliteobject', 'cache_timeout') // 60 * 30; my $timeout = $self->{pbot}->{registry}->get_value('dualindexsqliteobject', 'cache_timeout') // 60 * 30;
$self->{pbot}->{event_queue}->enqueue_event( $self->{pbot}->{event_queue}->enqueue_event(
@ -200,15 +182,12 @@ sub enqueue_decache {
); );
} }
sub dequeue_decache { sub dequeue_decache($self, $index1, $index2) {
my ($self, $index1, $index2) = @_;
my $key = ($index1 eq '.*' ? 'global' : $index1) . ".$index2"; my $key = ($index1 eq '.*' ? 'global' : $index1) . ".$index2";
$self->{pbot}->{event_queue}->dequeue("Decache $self->{name} $key"); $self->{pbot}->{event_queue}->dequeue("Decache $self->{name} $key");
} }
sub create_metadata { sub create_metadata($self, $columns) {
my ($self, $columns) = @_;
return if not $self->{dbh}; return if not $self->{dbh};
$self->{columns} = $columns; $self->{columns} = $columns;
@ -234,12 +213,7 @@ sub create_metadata {
} }
} }
sub levenshtein_matches { sub levenshtein_matches($self, $index1 = '.*', $index2 = undef, $distance = 0.60, $strictnamespace = 0) {
my ($self, $index1, $index2, $distance, $strictnamespace) = @_;
$index1 //= '.*';
$distance //= 0.60;
my $output = 'none'; my $output = 'none';
if (not $index2) { if (not $index2) {
@ -321,8 +295,7 @@ sub levenshtein_matches {
return $output; return $output;
} }
sub exists { sub exists($self, $index1 = undef, $index2 = undef, $data_index = undef) {
my ($self, $index1, $index2, $data_index) = @_;
return 0 if not defined $index1; return 0 if not defined $index1;
$index1 = lc $index1; $index1 = lc $index1;
return 0 if not grep { $_ eq $index1 } $self->get_keys; return 0 if not grep { $_ eq $index1 } $self->get_keys;
@ -333,9 +306,7 @@ sub exists {
return defined $self->get_data($index1, $index2, $data_index); return defined $self->get_data($index1, $index2, $data_index);
} }
sub get_keys { sub get_keys($self, $index1 = undef, $index2 = undef, $nocache = 0) {
my ($self, $index1, $index2, $nocache) = @_;
my @keys; my @keys;
if (not defined $index1) { if (not defined $index1) {
@ -428,9 +399,7 @@ sub get_keys {
return @keys; return @keys;
} }
sub get_each { sub get_each($self, @opts) {
my ($self, @opts) = @_;
my $sth = eval { my $sth = eval {
my $sql = 'SELECT '; my $sql = 'SELECT ';
my @keys = (); my @keys = ();
@ -536,9 +505,7 @@ sub get_each {
return $sth; return $sth;
} }
sub get_next { sub get_next($self, $sth) {
my ($self, $sth) = @_;
my $data = eval { my $data = eval {
return $sth->fetchrow_hashref; return $sth->fetchrow_hashref;
}; };
@ -551,9 +518,7 @@ sub get_next {
return $data; return $data;
} }
sub get_all { sub get_all($self, @opts) {
my ($self, @opts) = @_;
my $sth = $self->get_each(@opts); my $sth = $self->get_each(@opts);
my $data = eval { my $data = eval {
@ -568,9 +533,7 @@ sub get_all {
return @$data; return @$data;
} }
sub get_key_name { sub get_key_name($self, $index1, $index2 = undef) {
my ($self, $index1, $index2) = @_;
my $lc_index1 = lc $index1; my $lc_index1 = lc $index1;
if (not exists $self->{cache}->{$lc_index1}) { if (not exists $self->{cache}->{$lc_index1}) {
@ -598,9 +561,7 @@ sub get_key_name {
} }
} }
sub get_data { sub get_data($self, $index1, $index2, $data_index = undef) {
my ($self, $index1, $index2, $data_index) = @_;
my $lc_index1 = lc $index1; my $lc_index1 = lc $index1;
my $lc_index2 = lc $index2; my $lc_index2 = lc $index2;
@ -687,9 +648,7 @@ sub get_data {
return $value; return $value;
} }
sub add { sub add($self, $index1, $index2, $data, $quiet = 0) {
my ($self, $index1, $index2, $data, $quiet) = @_;
my $name1 = $self->get_data($index1, '_name') // $index1; my $name1 = $self->get_data($index1, '_name') // $index1;
eval { eval {
@ -762,9 +721,7 @@ sub add {
return "$index2 added to $name1."; return "$index2 added to $name1.";
} }
sub remove { sub remove($self, $index1, $index2 = undef, $data_index = undef, $dont_save = 0) {
my ($self, $index1, $index2, $data_index, $dont_save) = @_;
if (not $self->exists($index1)) { if (not $self->exists($index1)) {
my $result = "$self->{name}: $index1 not found; similiar matches: "; my $result = "$self->{name}: $index1 not found; similiar matches: ";
$result .= $self->levenshtein_matches($index1); $result .= $self->levenshtein_matches($index1);
@ -846,9 +803,7 @@ sub remove {
return "$name2.$data_index is not set."; return "$name2.$data_index is not set.";
} }
sub set { sub set($self, $index1, $index2, $key = undef, $value = undef) {
my ($self, $index1, $index2, $key, $value) = @_;
if (not $self->exists($index1)) { if (not $self->exists($index1)) {
my $result = "$self->{name}: $index1 not found; similiar matches: "; my $result = "$self->{name}: $index1 not found; similiar matches: ";
$result .= $self->levenshtein_matches($index1); $result .= $self->levenshtein_matches($index1);
@ -919,9 +874,7 @@ sub set {
return "[$name1] $name2.$key " . (defined $value ? "set to $value" : "is not set."); return "[$name1] $name2.$key " . (defined $value ? "set to $value" : "is not set.");
} }
sub unset { sub unset($self, $index1, $index2, $key) {
my ($self, $index1, $index2, $key) = @_;
if (not $self->exists($index1)) { if (not $self->exists($index1)) {
my $result = "$self->{name}: $index1 not found; similiar matches: "; my $result = "$self->{name}: $index1 not found; similiar matches: ";
$result .= $self->levenshtein_matches($index1); $result .= $self->levenshtein_matches($index1);

46
lib/PBot/Core/Storage/HashObject.pm
View File

@ -18,8 +18,7 @@ use PBot::Imports;
use Text::Levenshtein::XS qw(distance); use Text::Levenshtein::XS qw(distance);
use JSON; use JSON;
sub new { sub new($class, %args) {
my ($class, %args) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot}; Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot}; $self->{pbot} = delete $args{pbot};
@ -27,9 +26,7 @@ sub new {
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{name} = $conf{name} // 'unnammed'; $self->{name} = $conf{name} // 'unnammed';
$self->{hash} = {}; $self->{hash} = {};
$self->{filename} = $conf{filename}; $self->{filename} = $conf{filename};
@ -39,9 +36,7 @@ sub initialize {
} }
} }
sub load { sub load($self, $filename = undef) {
my ($self, $filename) = @_;
# allow overriding $self->{filename} with $filename parameter # allow overriding $self->{filename} with $filename parameter
$filename //= $self->{filename}; $filename //= $self->{filename};
@ -100,9 +95,7 @@ sub load {
} }
} }
sub save { sub save($self, $filename = undef) {
my ($self, $filename) = @_;
# allow parameter overriding internal field # allow parameter overriding internal field
$filename //= $self->{filename}; $filename //= $self->{filename};
@ -132,14 +125,11 @@ sub save {
close(FILE); close(FILE);
} }
sub clear { sub clear($self) {
my ($self) = @_;
$self->{hash} = {}; $self->{hash} = {};
} }
sub levenshtein_matches { sub levenshtein_matches($self, $keyword) {
my ($self, $keyword) = @_;
my @matches; my @matches;
foreach my $index (sort keys %{$self->{hash}}) { foreach my $index (sort keys %{$self->{hash}}) {
@ -165,8 +155,7 @@ sub levenshtein_matches {
return $result; return $result;
} }
sub set { sub set($self, $index, $key = undef, $value = undef, $dont_save = 0) {
my ($self, $index, $key, $value, $dont_save) = @_;
my $lc_index = lc $index; my $lc_index = lc $index;
# find similarly named keys # find similarly named keys
@ -207,8 +196,7 @@ sub set {
return "[$self->{name}] " . $self->get_key_name($lc_index) . ": $key " . (defined $value ? "set to $value" : "is not set."); return "[$self->{name}] " . $self->get_key_name($lc_index) . ": $key " . (defined $value ? "set to $value" : "is not set.");
} }
sub unset { sub unset($self, $index, $key = undef) {
my ($self, $index, $key) = @_;
my $lc_index = lc $index; my $lc_index = lc $index;
if (not exists $self->{hash}->{$lc_index}) { if (not exists $self->{hash}->{$lc_index}) {
@ -225,35 +213,30 @@ sub unset {
} }
} }
sub exists { sub exists($self, $index, $data_index = undef) {
my ($self, $index, $data_index) = @_;
return exists $self->{hash}->{lc $index} if not defined $data_index; return exists $self->{hash}->{lc $index} if not defined $data_index;
return exists $self->{hash}->{lc $index}->{$data_index}; return exists $self->{hash}->{lc $index}->{$data_index};
} }
sub get_key_name { sub get_key_name($self, $index) {
my ($self, $index) = @_;
my $lc_index = lc $index; my $lc_index = lc $index;
return $lc_index if not exists $self->{hash}->{$lc_index}; return $lc_index if not exists $self->{hash}->{$lc_index};
return exists $self->{hash}->{$lc_index}->{_name} ? $self->{hash}->{$lc_index}->{_name} : $lc_index; return exists $self->{hash}->{$lc_index}->{_name} ? $self->{hash}->{$lc_index}->{_name} : $lc_index;
} }
sub get_keys { sub get_keys($self, $index = undef) {
my ($self, $index) = @_;
return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $index; return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $index;
return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $index}}; return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $index}};
} }
sub get_data { sub get_data($self, $index, $data_index = undef) {
my ($self, $index, $data_index) = @_;
my $lc_index = lc $index; my $lc_index = lc $index;
return undef if not exists $self->{hash}->{$lc_index}; return undef if not exists $self->{hash}->{$lc_index};
return $self->{hash}->{$lc_index} if not defined $data_index; return $self->{hash}->{$lc_index} if not defined $data_index;
return $self->{hash}->{$lc_index}->{$data_index}; return $self->{hash}->{$lc_index}->{$data_index};
} }
sub add { sub add($self, $index, $data, $dont_save = 0) {
my ($self, $index, $data, $dont_save) = @_;
my $lc_index = lc $index; my $lc_index = lc $index;
# preserve case of index # preserve case of index
@ -266,8 +249,7 @@ sub add {
return "$index added to $self->{name}."; return "$index added to $self->{name}.";
} }
sub remove { sub remove($self, $index, $data_index = undef, $dont_save = 0) {
my ($self, $index, $data_index, $dont_save) = @_;
my $lc_index = lc $index; my $lc_index = lc $index;
if (not exists $self->{hash}->{$lc_index}) { if (not exists $self->{hash}->{$lc_index}) {

16
lib/PBot/Core/Updater.pm
View File

@ -16,15 +16,12 @@ use PBot::Imports;
use File::Basename; use File::Basename;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{data_dir} = $conf{data_dir}; $self->{data_dir} = $conf{data_dir};
$self->{update_dir} = $conf{update_dir}; $self->{update_dir} = $conf{update_dir};
} }
sub update { sub update($self) {
my ($self) = @_;
$self->{pbot}->{logger}->log("Checking if update needed...\n"); $self->{pbot}->{logger}->log("Checking if update needed...\n");
my $current_version = $self->get_current_version; my $current_version = $self->get_current_version;
@ -58,8 +55,7 @@ sub update {
return $self->put_last_update_version($current_version); return $self->put_last_update_version($current_version);
} }
sub get_available_updates { sub get_available_updates($self, $last_update_version) {
my ($self, $last_update_version) = @_;
my @updates = sort glob "$self->{update_dir}/*.pl"; my @updates = sort glob "$self->{update_dir}/*.pl";
return grep { my ($version) = split /_/, basename $_; $version > $last_update_version } @updates; return grep { my ($version) = split /_/, basename $_; $version > $last_update_version } @updates;
} }
@ -68,16 +64,14 @@ sub get_current_version {
return PBot::VERSION::BUILD_REVISION; return PBot::VERSION::BUILD_REVISION;
} }
sub get_last_update_version { sub get_last_update_version($self) {
my ($self) = @_;
open(my $fh, '<', "$self->{data_dir}/last_update") or return 0; open(my $fh, '<', "$self->{data_dir}/last_update") or return 0;
chomp(my $last_update = <$fh>); chomp(my $last_update = <$fh>);
close $fh; close $fh;
return $last_update; return $last_update;
} }
sub put_last_update_version { sub put_last_update_version($self, $version) {
my ($self, $version) = @_;
if (open(my $fh, '>', "$self->{data_dir}/last_update")) { if (open(my $fh, '>', "$self->{data_dir}/last_update")) {
print $fh "$version\n"; print $fh "$version\n";
close $fh; close $fh;

57
lib/PBot/Core/Users.pm
View File

@ -10,9 +10,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{storage} = PBot::Core::Storage::HashObject->new( $self->{storage} = PBot::Core::Storage::HashObject->new(
pbot => $conf{pbot}, pbot => $conf{pbot},
name => 'Users', name => 'Users',
@ -25,11 +23,9 @@ sub initialize {
$self->load; $self->load;
} }
sub add_user { sub add_user($self, $name, $channels, $hostmasks, $capabilities = 'none', $password = undef, $dont_save = 0) {
my ($self, $name, $channels, $hostmasks, $capabilities, $password, $dont_save) = @_;
$channels = 'global' if $channels !~ m/^#/; $channels = 'global' if $channels !~ m/^#/;
$capabilities //= 'none';
$password //= $self->{pbot}->random_nick(16); $password //= $self->{pbot}->random_nick(16);
my $data = { my $data = {
@ -49,16 +45,13 @@ sub add_user {
return $data; return $data;
} }
sub remove_user { sub remove_user($self, $name) {
my ($self, $name) = @_;
my $result = $self->{storage}->remove($name); my $result = $self->{storage}->remove($name);
$self->rebuild_user_index; $self->rebuild_user_index;
return $result; return $result;
} }
sub load { sub load($self) {
my $self = shift;
$self->{storage}->load; $self->{storage}->load;
$self->rebuild_user_index; $self->rebuild_user_index;
@ -75,14 +68,11 @@ sub load {
$self->{pbot}->{logger}->log(" $i users loaded.\n"); $self->{pbot}->{logger}->log(" $i users loaded.\n");
} }
sub save { sub save($self) {
my ($self) = @_;
$self->{storage}->save; $self->{storage}->save;
} }
sub rebuild_user_index { sub rebuild_user_index($self) {
my ($self) = @_;
$self->{user_index} = {}; $self->{user_index} = {};
$self->{user_cache} = {}; $self->{user_cache} = {};
@ -101,25 +91,21 @@ sub rebuild_user_index {
} }
} }
sub cache_user { sub cache_user($self, $channel, $hostmask, $username, $account_mask) {
my ($self, $channel, $hostmask, $username, $account_mask) = @_;
return if not length $username or not length $account_mask; return if not length $username or not length $account_mask;
$self->{user_cache}->{lc $channel}->{lc $hostmask} = [ $username, $account_mask ]; $self->{user_cache}->{lc $channel}->{lc $hostmask} = [ $username, $account_mask ];
} }
sub decache_user { sub decache_user($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
my $lc_channel = lc $channel; my $lc_channel = lc $channel;
my $lc_hostmask = lc $hostmask; my $lc_hostmask = lc $hostmask;
delete $self->{user_cache}->{$lc_channel}->{$lc_hostmask} if exists $self->{user_cache}->{$lc_channel}; delete $self->{user_cache}->{$lc_channel}->{$lc_hostmask} if exists $self->{user_cache}->{$lc_channel};
delete $self->{user_cache}->{global}->{$lc_hostmask}; delete $self->{user_cache}->{global}->{$lc_hostmask};
} }
sub find_user_account { sub find_user_account($self, $channel, $hostmask, $any_channel = 0) {
my ($self, $channel, $hostmask, $any_channel) = @_;
$channel = lc $channel; $channel = lc $channel;
$hostmask = lc $hostmask; $hostmask = lc $hostmask;
$any_channel //= 0;
# first try to find an exact match # first try to find an exact match
@ -167,9 +153,7 @@ sub find_user_account {
return (undef, $hostmask); return (undef, $hostmask);
} }
sub find_user { sub find_user($self, $channel, $hostmask, $any_channel = 0) {
my ($self, $channel, $hostmask, $any_channel) = @_;
$any_channel //= 0;
my ($found_channel, $found_hostmask) = $self->find_user_account($channel, $hostmask, $any_channel); my ($found_channel, $found_hostmask) = $self->find_user_account($channel, $hostmask, $any_channel);
return undef if not defined $found_channel; return undef if not defined $found_channel;
my $name = $self->{user_index}->{$found_channel}->{$found_hostmask}; my $name = $self->{user_index}->{$found_channel}->{$found_hostmask};
@ -177,16 +161,14 @@ sub find_user {
return wantarray ? ($self->{storage}->get_data($name), $name) : $self->{storage}->get_data($name); return wantarray ? ($self->{storage}->get_data($name), $name) : $self->{storage}->get_data($name);
} }
sub find_admin { sub find_admin($self, $from, $hostmask) {
my ($self, $from, $hostmask) = @_;
my $user = $self->find_user($from, $hostmask); my $user = $self->find_user($from, $hostmask);
return undef if not defined $user; return undef if not defined $user;
return undef if not $self->{pbot}->{capabilities}->userhas($user, 'admin'); return undef if not $self->{pbot}->{capabilities}->userhas($user, 'admin');
return $user; return $user;
} }
sub login { sub login($self, $channel, $hostmask, $password = undef) {
my ($self, $channel, $hostmask, $password) = @_;
my $user = $self->find_user($channel, $hostmask); my $user = $self->find_user($channel, $hostmask);
my $channel_text = $channel eq 'global' ? '' : " for $channel"; my $channel_text = $channel eq 'global' ? '' : " for $channel";
@ -207,35 +189,30 @@ sub login {
return "Logged into " . $self->{storage}->get_key_name($name) . " ($hostmask)$channel_text."; return "Logged into " . $self->{storage}->get_key_name($name) . " ($hostmask)$channel_text.";
} }
sub logout { sub logout($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
my $user = $self->find_user($channel, $hostmask); my $user = $self->find_user($channel, $hostmask);
delete $user->{loggedin} if defined $user; delete $user->{loggedin} if defined $user;
} }
sub loggedin { sub loggedin($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
my $user = $self->find_user($channel, $hostmask); my $user = $self->find_user($channel, $hostmask);
return $user if defined $user and $user->{loggedin}; return $user if defined $user and $user->{loggedin};
return undef; return undef;
} }
sub loggedin_admin { sub loggedin_admin($self, $channel, $hostmask) {
my ($self, $channel, $hostmask) = @_;
my $user = $self->loggedin($channel, $hostmask); my $user = $self->loggedin($channel, $hostmask);
return $user if defined $user and $self->{pbot}->{capabilities}->userhas($user, 'admin'); return $user if defined $user and $self->{pbot}->{capabilities}->userhas($user, 'admin');
return undef; return undef;
} }
sub get_user_metadata { sub get_user_metadata($self, $channel, $hostmask, $key) {
my ($self, $channel, $hostmask, $key) = @_;
my $user = $self->find_user($channel, $hostmask, 1); my $user = $self->find_user($channel, $hostmask, 1);
return $user->{lc $key} if $user; return $user->{lc $key} if $user;
return undef; return undef;
} }
sub get_loggedin_user_metadata { sub get_loggedin_user_metadata($self, $channel, $hostmask, $key) {
my ($self, $channel, $hostmask, $key) = @_;
my $user = $self->loggedin($channel, $hostmask); my $user = $self->loggedin($channel, $hostmask);
return $user->{lc $key} if $user; return $user->{lc $key} if $user;
return undef; return undef;

16
lib/PBot/Core/Utils/LWPUserAgentCached.pm
View File

@ -4,7 +4,7 @@
# the 'expires' or 'Last-Modified' attributes, we always cache for the # the 'expires' or 'Last-Modified' attributes, we always cache for the
# specified duration. # specified duration.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
package PBot::Core::Utils::LWPUserAgentCached; package PBot::Core::Utils::LWPUserAgentCached;
@ -22,17 +22,16 @@ our %default_cache_args = (
'default_expires_in' => 600 'default_expires_in' => 600
); );
sub new { sub new($class, @args) {
my $class = shift;
my $cache_opt; my $cache_opt;
my %lwp_opt; my %lwp_opt;
unless (scalar @_ % 2) { unless (scalar @args % 2) {
%lwp_opt = @_; %lwp_opt = @args;
$cache_opt = {}; $cache_opt = {};
for my $key (qw(namespace cache_root default_expires_in)) { $cache_opt->{$key} = delete $lwp_opt{$key} if exists $lwp_opt{$key}; } for my $key (qw(namespace cache_root default_expires_in)) { $cache_opt->{$key} = delete $lwp_opt{$key} if exists $lwp_opt{$key}; }
} else { } else {
$cache_opt = shift || {}; $cache_opt = shift @args || {};
%lwp_opt = @_; %lwp_opt = @args;
} }
my $self = $class->SUPER::new(%lwp_opt); my $self = $class->SUPER::new(%lwp_opt);
my %cache_args = (%default_cache_args, %$cache_opt); my %cache_args = (%default_cache_args, %$cache_opt);
@ -40,8 +39,7 @@ sub new {
return $self; return $self;
} }
sub request { sub request($self, @args) {
my ($self, @args) = @_;
my $request = $args[0]; my $request = $args[0];
return $self->SUPER::request(@args) if $request->method ne 'GET'; return $self->SUPER::request(@args) if $request->method ne 'GET';

4
lib/PBot/Core/Utils/LoadModules.pm
View File

@ -16,9 +16,7 @@ require Exporter;
our @ISA = qw/Exporter/; our @ISA = qw/Exporter/;
our @EXPORT = qw/load_modules/; our @EXPORT = qw/load_modules/;
sub load_modules { sub load_modules($self, $base) {
my ($self, $base) = @_;
my $base_path = join '/', split '::', $base; my $base_path = join '/', split '::', $base;
foreach my $inc_path (@INC) { foreach my $inc_path (@INC) {

14
lib/PBot/Core/Utils/ParseDate.pm
View File

@ -14,22 +14,18 @@ use DateTime;
use DateTime::Format::Flexible; use DateTime::Format::Flexible;
use DateTime::Format::Duration; use DateTime::Format::Duration;
sub new { sub new($class, %args) {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
my ($class, %args) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
$self->initialize(%args); $self->initialize(%args);
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__); $self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
} }
# expands stuff like "7d3h" to "7 days and 3 hours" # expands stuff like "7d3h" to "7 days and 3 hours"
sub unconcise { sub unconcise($input) {
my ($input) = @_;
my %word = (y => 'years', w => 'weeks', d => 'days', h => 'hours', m => 'minutes', s => 'seconds'); my %word = (y => 'years', w => 'weeks', d => 'days', h => 'hours', m => 'minutes', s => 'seconds');
$input =~ s/(\d+)([ywdhms])(?![a-z])/"$1 " . $word{lc $2} . ' and '/ige; $input =~ s/(\d+)([ywdhms])(?![a-z])/"$1 " . $word{lc $2} . ' and '/ige;
$input =~ s/ and $//; $input =~ s/ and $//;
@ -38,9 +34,7 @@ sub unconcise {
# parses English natural language date strings into seconds # parses English natural language date strings into seconds
# does not accept times or dates in the past # does not accept times or dates in the past
sub parsedate { sub parsedate($self, $input) {
my ($self, $input) = @_;
my $examples = "Try `30s`, `1h30m`, `tomorrow`, `next monday`, `9:30am pdt`, `11pm utc`, etc."; my $examples = "Try `30s`, `1h30m`, `tomorrow`, `next monday`, `9:30am pdt`, `11pm utc`, etc.";
my $attempts = 0; my $attempts = 0;

34
lib/PBot/Core/Utils/PriorityQueue.pm
View File

@ -9,52 +9,40 @@ package PBot::Core::Utils::PriorityQueue;
use PBot::Imports; use PBot::Imports;
sub new { sub new($class, %args) {
my ($class, %args) = @_;
return bless { return bless {
# list of entries; each entry is expected to have a `priority` and an `id` field # list of entries; each entry is expected to have a `priority` and an `id` field
queue => [], queue => [],
}, $class; }, $class;
} }
sub queue { sub queue($self) {
my ($self) = @_;
return $self->{queue}; return $self->{queue};
} }
sub entries { sub entries($self) {
my ($self) = @_;
return @{$self->{queue}}; return @{$self->{queue}};
} }
sub count { sub count($self) {
my ($self) = @_;
return scalar @{$self->{queue}}; return scalar @{$self->{queue}};
} }
sub get { sub get($self, $position) {
my ($self, $position) = @_;
return $self->{queue}->[$position]; return $self->{queue}->[$position];
} }
sub get_priority { sub get_priority($self, $position) {
my ($self, $position) = @_;
return $self->{queue}->[$position]->{priority}; return $self->{queue}->[$position]->{priority};
} }
sub remove { sub remove($self, $position) {
my ($self, $position) = @_;
return splice @{$self->{queue}}, $position, 1; return splice @{$self->{queue}}, $position, 1;
} }
# quickly and efficiently find the best position in the entry # quickly and efficiently find the best position in the entry
# queue array for a given priority value # queue array for a given priority value
sub find_enqueue_position { sub find_enqueue_position($self, $priority = 0) {
my ($self, $priority) = @_;
$priority //= 0;
# shorter alias # shorter alias
my $queue = $self->{queue}; my $queue = $self->{queue};
@ -98,15 +86,13 @@ sub find_enqueue_position {
return $lo; return $lo;
} }
sub add { sub add($self, $entry) {
my ($self, $entry) = @_;
my $position = $self->find_enqueue_position($entry->{priority}); my $position = $self->find_enqueue_position($entry->{priority});
splice @{$self->{queue}}, $position, 0, $entry; splice @{$self->{queue}}, $position, 0, $entry;
return $position; return $position;
} }
sub update_priority { sub update_priority($self, $id, $priority) {
my ($self, $id, $priority) = @_;
my @entries = grep { $_->{id} eq $id } @{$self->{queue}}; my @entries = grep { $_->{id} eq $id } @{$self->{queue}};
map { $_->{priority} = $priority } @entries; map { $_->{priority} = $priority } @entries;
$self->{queue} = [ sort { $a->{priority} <=> $b->{priority} } @{$self->{queue}} ]; $self->{queue} = [ sort { $a->{priority} <=> $b->{priority} } @{$self->{queue}} ];

16
lib/PBot/Core/Utils/SQLiteLogger.pm
View File

@ -12,9 +12,7 @@ use PBot::Imports;
use Time::HiRes qw(gettimeofday); use Time::HiRes qw(gettimeofday);
sub new { sub new($class, %args) {
my ($class, %args) = @_;
my $self = { my $self = {
pbot => $args{pbot}, pbot => $args{pbot},
buf => '', buf => '',
@ -24,9 +22,7 @@ sub new {
return bless $self, $class; return bless $self, $class;
} }
sub log { sub log($self) {
my $self = shift;
$self->{buf} .= shift; $self->{buf} .= shift;
# DBI feeds us pieces at a time, so accumulate a complete line # DBI feeds us pieces at a time, so accumulate a complete line
@ -37,9 +33,7 @@ sub log {
} }
} }
sub log_message { sub log_message($self) {
my ($self) = @_;
my $now = gettimeofday; my $now = gettimeofday;
my $elapsed = $now - $self->{timestamp}; my $elapsed = $now - $self->{timestamp};
@ -54,9 +48,7 @@ sub log_message {
$self->{timestamp} = $now; $self->{timestamp} = $now;
} }
sub close { sub close($self) {
my ($self) = @_;
# log anything left in buf when closing # log anything left in buf when closing
if ($self->{buf}) { if ($self->{buf}) {
$self->log_message; $self->log_message;

12
lib/PBot/Core/Utils/SQLiteLoggerLayer.pm
View File

@ -9,26 +9,22 @@ package PBot::Core::Utils::SQLiteLoggerLayer;
use PBot::Imports; use PBot::Imports;
sub PUSHED { sub PUSHED($class, $mode, $fh) {
my ($class, $mode, $fh) = @_;
my $logger; my $logger;
return bless \$logger, $class; return bless \$logger, $class;
} }
sub OPEN { sub OPEN($self, $path, $mode, $fh) {
my ($self, $path, $mode, $fh) = @_;
$$self = $path; # path is our PBot::Logger object $$self = $path; # path is our PBot::Logger object
return 1; return 1;
} }
sub WRITE { sub WRITE($self, $buf, $fh) {
my ($self, $buf, $fh) = @_;
$$self->log($buf); # log message $$self->log($buf); # log message
return length($buf); return length($buf);
} }
sub CLOSE { sub CLOSE($self) {
my ($self) = @_;
$$self->close(); $$self->close();
return 0; return 0;
} }

3
lib/PBot/Core/Utils/SafeFilename.pm
View File

@ -14,8 +14,7 @@ require Exporter;
our @ISA = qw/Exporter/; our @ISA = qw/Exporter/;
our @EXPORT = qw/safe_filename/; our @EXPORT = qw/safe_filename/;
sub safe_filename { sub safe_filename($name) {
my ($name) = @_;
my $safe = ''; my $safe = '';
while ($name =~ m/(.)/gms) { while ($name =~ m/(.)/gms) {

11
lib/PBot/Core/Utils/ValidateString.pm
View File

@ -37,17 +37,12 @@ use Unicode::Truncate;
# #
# if $max_length is 0, no truncation occurs. # if $max_length is 0, no truncation occurs.
sub validate_string { sub validate_string($string, $max_length = 1024 * 8) {
my ($string, $max_length) = @_;
if (not defined $string or not length $string) { if (not defined $string or not length $string) {
# nothing to validate; return as-is. # nothing to validate; return as-is.
return $string; return $string;
} }
# set default max length if none given
$max_length //= 1024 * 8;
local $@; local $@;
eval { eval {
# attempt to decode as a JSON string # attempt to decode as a JSON string
@ -86,9 +81,7 @@ sub validate_string {
# validates the string. # validates the string.
# safely performs Unicode truncation given a byte length, handles # safely performs Unicode truncation given a byte length, handles
# unwanted characters, etc. # unwanted characters, etc.
sub validate_this_string { sub validate_this_string($string, $max_length = 1024 * 8) {
my ($string, $max_length) = @_;
# truncate safely # truncate safely
if ($max_length > 0) { if ($max_length > 0) {
$string = encode('UTF-8', $string); $string = encode('UTF-8', $string);

20
lib/PBot/Core/WebPaste.pm
View File

@ -15,9 +15,7 @@ use Time::Duration;
use LWP::UserAgent::Paranoid; use LWP::UserAgent::Paranoid;
use Encode; use Encode;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# There used to be many more paste sites in this list but one by one # There used to be many more paste sites in this list but one by one
# many have died off. :-( # many have died off. :-(
@ -29,9 +27,7 @@ sub initialize {
$self->{current_site} = 0; $self->{current_site} = 0;
} }
sub get_paste_site { sub get_paste_site($self) {
my ($self) = @_;
# get the next paste site's subroutine reference # get the next paste site's subroutine reference
my $subref = $self->{paste_sites}->[$self->{current_site}]; my $subref = $self->{paste_sites}->[$self->{current_site}];
@ -43,9 +39,7 @@ sub get_paste_site {
return $subref; return $subref;
} }
sub paste { sub paste($self, $text, %opts) {
my ($self, $text, %opts) = @_;
my %default_opts = ( my %default_opts = (
no_split => 0, no_split => 0,
); );
@ -84,9 +78,7 @@ sub paste {
return $result; return $result;
} }
sub paste_0x0st { sub paste_0x0st($self, $text) {
my ($self, $text) = @_;
my $ua = LWP::UserAgent::Paranoid->new(request_timeout => 10); my $ua = LWP::UserAgent::Paranoid->new(request_timeout => 10);
push @{$ua->requests_redirectable}, 'POST'; push @{$ua->requests_redirectable}, 'POST';
@ -98,9 +90,7 @@ sub paste_0x0st {
); );
} }
sub paste_ixio { sub paste_ixio($self, $text) {
my ($self, $text) = @_;
my $ua = LWP::UserAgent::Paranoid->new(request_timeout => 10); my $ua = LWP::UserAgent::Paranoid->new(request_timeout => 10);
push @{$ua->requests_redirectable}, 'POST'; push @{$ua->requests_redirectable}, 'POST';

3
lib/PBot/Imports.pm
View File

@ -31,7 +31,6 @@ sub import {
warnings->unimport::out_of($target, 'experimental'); warnings->unimport::out_of($target, 'experimental');
} }
sub unimport { sub unimport {}
}
1; 1;

3
lib/PBot/Plugin/Spinach.pm
View File

@ -96,7 +96,7 @@ sub on_departure($self, $event_type, $event) {
return 0; return 0;
} }
sub load_questions($self, $filename) { sub load_questions($self, $filename = undef) {
if (not defined $filename) { if (not defined $filename) {
$filename = exists $self->{loaded_filename} ? $self->{loaded_filename} : $self->{questions_filename}; $filename = exists $self->{loaded_filename} ? $self->{loaded_filename} : $self->{questions_filename};
} else { } else {
@ -597,6 +597,7 @@ sub cmd_spinach($self, $context) {
} }
when ($_ eq 'lie' or $_ eq 'truth' or $_ eq 'choose') { when ($_ eq 'lie' or $_ eq 'truth' or $_ eq 'choose') {
$arguments //= '';
$arguments = lc $arguments; $arguments = lc $arguments;
if ($self->{current_state} =~ /choosecategory$/) { if ($self->{current_state} =~ /choosecategory$/) {
if (not length $arguments) { return "Usage: spinach choose <integer>"; } if (not length $arguments) { return "Usage: spinach choose <integer>"; }

2
lib/PBot/VERSION.pm
View File

@ -25,7 +25,7 @@ use PBot::Imports;
# These are set by the /misc/update_version script # These are set by the /misc/update_version script
use constant { use constant {
BUILD_NAME => "PBot", BUILD_NAME => "PBot",
BUILD_REVISION => 4647, BUILD_REVISION => 4648,
BUILD_DATE => "2023-04-13", BUILD_DATE => "2023-04-13",
}; };