GitHub
/
pbot
mirror of https://github.com/pragma-/pbot.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity

Update core to use subroutine signatures

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;
}
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
my $self = bless {}, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{startup_timestamp} = time;
# process command-line arguments for path and registry overrides
@ -225,8 +222,7 @@ sub initialize {
$self->{logger}->log("PBot::Core initialized.\n");
}
sub random_nick {
my ($self, $length) = @_;
sub random_nick($self, $length) {
$length //= 9;
my @chars = ("A" .. "Z", "a" .. "z", "0" .. "9");
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
sub connect {
my ($self) = @_;
sub connect($self) {
return if $ENV{PBOT_LOCAL};
my $server = $self->{registry}->get_value('irc', 'server');
@ -301,9 +295,7 @@ sub connect {
$self->{irchandlers}->add_handlers;
}
sub register_signal_handlers {
my ($self) = @_;
sub register_signal_handlers($self) {
$SIG{INT} = sub {
my $msg = "SIGINT received, exiting immediately.\n";
if (exists $self->{logger}) {
@ -317,8 +309,7 @@ sub register_signal_handlers {
}
# called when PBot terminates
sub atexit {
my ($self) = @_;
sub atexit($self) {
$self->{atexit}->execute_all;
if (exists $self->{logger}) {
$self->{logger}->log("Good-bye.\n");
@ -328,8 +319,7 @@ sub atexit {
}
# convenient function to exit PBot
sub exit {
my ($self, $exitval) = @_;
sub exit($self, $exitval) {
$exitval //= EXIT_SUCCESS;
my $msg = "Exiting immediately.\n";
@ -344,9 +334,7 @@ sub exit {
}
# main loop
sub do_one_loop {
my ($self) = @_;
sub do_one_loop($self) {
# do an irc engine loop (select, eventqueues, etc)
$self->{irc}->do_one_loop;
@ -359,9 +347,7 @@ sub do_one_loop {
}
# main entry point
sub start {
my ($self) = @_;
sub start($self) {
$self->connect;
while (1) {

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

@ -21,9 +21,7 @@ use Time::Duration;
use POSIX qw/strftime/;
use Text::CSV;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# flags for 'validated' field
use constant {
NICKSERV_VALIDATED => (1 << 0),
@ -64,9 +62,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.account', sub { $self->on_accountnotify(@_) });
}
sub update_join_watch {
my ($self, $account, $channel, $text, $mode) = @_;
sub update_join_watch($self, $account, $channel, $text, $mode) {
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');
@ -103,9 +99,7 @@ sub update_join_watch {
# TODO: break this gigantic function up into simple plugins
# e.g. PBot::Plugin::AntiAbuse::ChatFlood, ::JoinFlood, ::EnterAbuse, etc.
sub check_flood {
my ($self, $channel, $nick, $user, $host, $text, $max_messages, $max_time, $mode, $context) = @_;
sub check_flood($self, $channel, $nick, $user, $host, $text, $max_messages, $max_time, $mode, $context = undef) {
$channel = lc $channel;
my $mask = "$nick!$user\@$host";
@ -569,8 +563,7 @@ sub check_flood {
$self->{channels}->{$channel}->{last_spoken_nick} = $nick if $mode == MSG_CHAT;
}
sub address_to_mask {
my ($self, $address) = @_;
sub address_to_mask($self, $address) {
my $banmask;
if ($address =~ m/^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/) {
@ -595,9 +588,8 @@ sub address_to_mask {
return $banmask;
}
sub devalidate_accounts {
# remove validation on accounts in $channel that match a ban/quiet $mask
my ($self, $mask, $channel) = @_;
# remove validation on accounts in $channel that match a ban/quiet $mask
sub devalidate_accounts($self, $mask, $channel) {
my @message_accounts;
#$self->{pbot}->{logger}->log("Devalidating accounts for $mask in $channel\n");
@ -620,8 +612,7 @@ sub devalidate_accounts {
}
}
sub check_bans {
my ($self, $message_account, $mask, $channel, $dry_run) = @_;
sub check_bans($self, $message_account, $mask, $channel, $dry_run = 0) {
$channel = lc $channel;
return if not $self->{pbot}->{chanops}->can_gain_ops($channel);
@ -845,8 +836,7 @@ sub check_bans {
}
}
sub on_endofwhois {
my ($self, $event_type, $event) = @_;
sub on_endofwhois($self, $event_type, $event) {
my $nick = $event->{args}[1];
delete $self->{whois_pending}->{$nick};
@ -869,8 +859,7 @@ sub on_endofwhois {
return 0;
}
sub on_whoisuser {
my ($self, $event_type, $event) = @_;
sub on_whoisuser($self, $event_type, $event) {
my $nick = $event->{args}[1];
my $gecos = lc $event->{args}[5];
@ -881,8 +870,7 @@ sub on_whoisuser {
$self->{pbot}->{messagehistory}->{database}->update_gecos($id, $gecos, scalar gettimeofday);
}
sub on_whoisaccount {
my ($self, $event_type, $event) = @_;
sub on_whoisaccount($self, $event_type, $event) {
my $nick = $event->{args}[1];
my $account = lc $event->{args}[2];
@ -901,9 +889,7 @@ sub on_whoisaccount {
return 0;
}
sub on_accountnotify {
my ($self, $event_type, $event) = @_;
sub on_accountnotify($self, $event_type, $event) {
my $mask = $event->{from};
my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/;
my $account = $event->{args}[0];
@ -933,11 +919,7 @@ sub on_accountnotify {
return 0;
}
sub adjust_offenses {
my $self = shift;
#$self->{pbot}->{logger}->log("Adjusting offenses . . .\n");
sub adjust_offenses($self) {
# 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);
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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
my $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spam_keywords';
$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);
}
sub is_spam {
my ($self, $namespace, $text, $all_namespaces) = @_;
sub is_spam($self, $namespace, $text, $all_namespaces = 0) {
my $lc_namespace = lc $namespace;
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
}
sub execute_applet {
my ($self, $context) = @_;
sub execute_applet($self, $context) {
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
@ -34,9 +32,7 @@ sub execute_applet {
$self->{pbot}->{process_manager}->execute_process($context, sub { $self->launch_applet(@_) });
}
sub launch_applet {
my ($self, $context) = @_;
sub launch_applet($self, $context) {
$context->{arguments} //= '';
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 POSIX qw/strftime/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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', 'debug', '0');
@ -61,9 +59,7 @@ sub initialize {
$self->{pbot}->{event_queue}->enqueue(sub { $self->flush_unban_queue }, 30, 'Flush unban queue');
}
sub checkban {
my ($self, $channel, $mode, $mask) = @_;
sub checkban($self, $channel, $mode, $mask) {
$mask = $self->nick_to_banmask($mask);
my $data;
@ -97,15 +93,12 @@ sub checkban {
return $result;
}
sub is_ban_exempted {
my ($self, $channel, $hostmask) = @_;
sub is_ban_exempted($self, $channel, $hostmask) {
return 1 if $self->{'ban-exemptions'}->exists(lc $channel, lc $hostmask);
return 0;
}
sub is_banned {
my ($self, $channel, $nick, $user, $host) = @_;
sub is_banned($self, $channel, $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);
push @nickserv_accounts, undef;
@ -137,11 +130,7 @@ sub is_banned {
return $banned;
}
sub has_ban_timeout {
my ($self, $channel, $mask, $mode) = @_;
$mode ||= 'b';
sub has_ban_timeout($self, $channel, $mask, $mode = 'b') {
my $list = $mode eq 'b' ? $self->{banlist} : $self->{quietlist};
my $data = $list->get_data($channel, $mask);
@ -153,9 +142,7 @@ sub has_ban_timeout {
}
}
sub ban_user_timed {
my ($self, $channel, $mode, $mask, $length, $owner, $reason, $immediately) = @_;
sub ban_user_timed($self, $channel, $mode, $mask, $length, $owner, $reason, $immediately = 0) {
$channel = lc $channel;
$mask = lc $mask;
@ -185,28 +172,22 @@ sub ban_user_timed {
}
}
sub ban_user {
my ($self, $channel, $mode, $mask, $immediately) = @_;
$mode ||= 'b';
sub ban_user($self, $channel, $mode, $mask, $immediately = 0) {
$self->{pbot}->{logger}->log("Banning $channel +$mode $mask\n");
$self->add_to_ban_queue($channel, $mode, $mask);
if (not defined $immediately or $immediately != 0) {
if ($immediately) {
$self->flush_ban_queue;
}
}
sub unban_user {
my ($self, $channel, $mode, $mask, $immediately) = @_;
sub unban_user($self, $channel, $mode, $mask, $immediately = 0) {
$mask = lc $mask;
$channel = lc $channel;
$mode ||= 'b';
$self->{pbot}->{logger}->log("Unbanning $channel -$mode $mask\n");
$self->unmode_user($channel, $mode, $mask, $immediately);
}
sub unmode_user {
my ($self, $channel, $mode, $mask, $immediately) = @_;
sub unmode_user($self, $channel, $mode, $mask, $immediately = 0) {
$mask = lc $mask;
$channel = lc $channel;
$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;
}
sub get_bans {
my ($self, $channel, $mask) = @_;
sub get_bans($self, $channel, $mask) {
my $masks;
my ($message_account, $hostmask);
@ -264,8 +243,7 @@ sub get_bans {
return $masks;
}
sub get_baninfo {
my ($self, $channel, $mask, $nickserv) = @_;
sub get_baninfo($self, $channel, $mask, $nickserv) {
my ($bans, $ban_nickserv);
$nickserv = undef if not length $nickserv;
@ -334,9 +312,7 @@ sub get_baninfo {
return $bans;
}
sub nick_to_banmask {
my ($self, $mask) = @_;
sub nick_to_banmask($self, $mask) {
if ($mask !~ m/[!@\$]/) {
my ($message_account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($mask);
if (defined $hostmask) {
@ -369,25 +345,21 @@ sub nick_to_banmask {
return $mask;
}
sub add_to_ban_queue {
my ($self, $channel, $mode, $mask) = @_;
sub add_to_ban_queue($self, $channel, $mode, $mask) {
if (not grep { $_ eq $mask } @{$self->{ban_queue}->{$channel}->{$mode}}) {
push @{$self->{ban_queue}->{$channel}->{$mode}}, $mask;
$self->{pbot}->{logger}->log("Added +$mode $mask for $channel to ban queue.\n");
}
}
sub add_to_unban_queue {
my ($self, $channel, $mode, $mask) = @_;
sub add_to_unban_queue($self, $channel, $mode, $mask) {
if (not grep { $_ eq $mask } @{$self->{unban_queue}->{$channel}->{$mode}}) {
push @{$self->{unban_queue}->{$channel}->{$mode}}, $mask;
$self->{pbot}->{logger}->log("Added -$mode $mask for $channel to unban queue.\n");
}
}
sub flush_ban_queue {
my $self = shift;
sub flush_ban_queue($self) {
my $MAX_COMMANDS = 4;
my $commands = 0;
@ -428,9 +400,7 @@ sub flush_ban_queue {
}
}
sub flush_unban_queue {
my $self = shift;
sub flush_unban_queue($self) {
my $MAX_COMMANDS = 4;
my $commands = 0;
@ -471,9 +441,7 @@ sub flush_unban_queue {
}
}
sub enqueue_unban {
my ($self, $channel, $mode, $hostmask, $interval) = @_;
sub enqueue_unban($self, $channel, $mode, $hostmask, $interval) {
my $method = $mode eq 'b' ? 'unban' : 'unmute';
$self->{pbot}->{event_queue}->enqueue_event(
@ -485,8 +453,7 @@ sub enqueue_unban {
);
}
sub enqueue_timeouts {
my ($self, $list, $mode) = @_;
sub enqueue_timeouts($self, $list, $mode) {
my $now = time;
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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{filename} = $conf{filename};
$self->{storage} = {};
$self->load;
}
sub add {
my ($self, $channel, $hostmask) = @_;
sub add($self, $channel, $hostmask) {
$self->{storage}->{lc $channel}->{lc $hostmask} = 1;
$self->save;
}
sub remove {
my ($self, $channel, $hostmask) = @_;
sub remove($self, $channel, $hostmask) {
$channel = lc $channel;
$hostmask = lc $hostmask;
@ -40,14 +36,11 @@ sub remove {
$self->save;
}
sub clear {
my ($self) = @_;
sub clear($self) {
$self->{storage} = {};
}
sub load {
my ($self) = @_;
sub load($self) {
if (not $self->{filename}) {
$self->{pbot}->{logger}->log("No blacklist path specified -- skipping loading of blacklist");
return;
@ -81,9 +74,7 @@ sub load {
$self->{pbot}->{logger}->log(" $i entries in blacklist\n");
}
sub save {
my ($self) = @_;
sub save($self) {
if (not $self->{filename}) {
$self->{pbot}->{logger}->log("No blacklist path specified -- skipping saving of blacklist\n");
return;
@ -100,9 +91,7 @@ sub save {
close FILE;
}
sub is_blacklisted {
my ($self, $hostmask, $channel, $nickserv, $gecos) = @_;
sub is_blacklisted($self, $hostmask, $channel, $nickserv = undef, $gecos = undef) {
return 0 if not defined $channel;
my $result = eval {

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

@ -10,9 +10,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# capabilities file
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);
}
sub has {
my ($self, $cap, $subcap, $depth) = @_;
sub has($self, $cap, $subcap, $depth = 10) {
my $cap_data = $self->{caps}->get_data($cap);
return 0 if not defined $cap_data;
@ -45,8 +42,6 @@ sub has {
return 1;
}
$depth //= 10; # set depth to 10 if it's not defined
if (--$depth <= 0) {
$self->{pbot}->{logger}->log("Max recursion reached for PBot::Core::Capabilities->has($cap, $subcap)\n");
return 0;
@ -60,9 +55,7 @@ sub has {
return 0;
}
sub userhas {
my ($self, $user, $cap) = @_;
sub userhas($self, $user, $cap) {
return 0 if not defined $user;
return 1 if $user->{$cap};
@ -75,9 +68,7 @@ sub userhas {
return 0;
}
sub exists {
my ($self, $cap) = @_;
sub exists($self, $cap) {
$cap = lc $cap;
foreach my $c ($self->{caps}->get_keys) {
@ -91,9 +82,7 @@ sub exists {
return 0;
}
sub add {
my ($self, $cap, $subcap, $dontsave) = @_;
sub add($self, $cap, $subcap, $dontsave = 0) {
$cap = lc $cap;
if (not defined $subcap) {
@ -109,9 +98,7 @@ sub add {
}
}
sub remove {
my ($self, $cap, $subcap) = @_;
sub remove($self, $cap, $subcap) {
$cap = lc $cap;
if (not defined $subcap) {
@ -128,9 +115,7 @@ sub remove {
$self->{caps}->save;
}
sub rebuild_botowner_capabilities {
my ($self) = @_;
sub rebuild_botowner_capabilities($self) {
$self->{caps}->remove('botowner', undef, 1);
foreach my $cap ($self->{caps}->get_keys) {
@ -138,9 +123,7 @@ sub rebuild_botowner_capabilities {
}
}
sub list {
my ($self, $capability) = @_;
sub list($self, $capability) {
if (defined $capability and not $self->{caps}->exists($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::Duration qw(concise duration);
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{op_commands} = {}; # OP command queue
$self->{op_requested} = {}; # channels PBot has requested 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
sub can_gain_ops {
my ($self, $channel) = @_;
sub can_gain_ops($self, $channel) {
return
$self->{pbot}->{channels}->{storage}->exists($channel)
&& $self->{pbot}->{channels}->{storage}->get_data($channel, 'chanop')
@ -43,8 +40,7 @@ sub can_gain_ops {
}
# sends request to gain OP status in $channel
sub gain_ops {
my ($self, $channel) = @_;
sub gain_ops($self, $channel) {
$channel = lc $channel;
return if exists $self->{op_requested}->{$channel};
@ -71,22 +67,19 @@ sub gain_ops {
}
# removes OP status in $channel
sub lose_ops {
my ($self, $channel) = @_;
sub lose_ops($self, $channel) {
$channel = lc $channel;
$self->{pbot}->{conn}->mode($channel, '-o ' . $self->{pbot}->{registry}->get_value('irc', 'botnick'));
}
# adds a command to the OP command queue
sub add_op_command {
my ($self, $channel, $command) = @_;
sub add_op_command($self, $channel, $command) {
return if not $self->can_gain_ops($channel);
push @{$self->{op_commands}->{lc $channel}}, $command;
}
# invokes commands in OP command queue
sub perform_op_commands {
my ($self, $channel) = @_;
sub perform_op_commands($self, $channel) {
$channel = lc $channel;
$self->{pbot}->{logger}->log("Performing op commands in $channel:\n");
@ -112,8 +105,7 @@ sub perform_op_commands {
}
# manages OP-related timeouts
sub check_opped_timeouts {
my $self = shift;
sub check_opped_timeouts($self) {
my $now = gettimeofday();
foreach my $channel (keys %{$self->{is_opped}}) {
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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{storage} = PBot::Core::Storage::HashObject->new(
pbot => $self->{pbot},
name => 'Channels',
@ -30,9 +28,7 @@ sub initialize {
);
}
sub join {
my ($self, $channels) = @_;
sub join($self, $channels) {
return if not $channels;
$self->{pbot}->{conn}->join($channels);
@ -44,16 +40,13 @@ sub join {
}
}
sub part {
my ($self, $channel) = @_;
sub part($self, $channel) {
$channel = lc $channel;
$self->{pbot}->{event_dispatcher}->dispatch_event('pbot.part', { channel => $channel });
$self->{pbot}->{conn}->part($channel);
}
sub autojoin {
my ($self) = @_;
sub autojoin($self) {
return if $self->{pbot}->{joined_channels};
my $channels;
@ -71,19 +64,15 @@ sub autojoin {
$self->{pbot}->{joined_channels} = 1;
}
sub is_active {
my ($self, $channel) = @_;
# returns undef if channel doesn't exist; otherwise, the value of 'enabled'
sub is_active($self, $channel) {
return $self->{storage}->get_data($channel, 'enabled');
}
sub is_active_op {
my ($self, $channel) = @_;
sub is_active_op($self, $channel) {
return $self->is_active($channel) && $self->{storage}->get_data($channel, 'chanop');
}
sub get_meta {
my ($self, $channel, $key) = @_;
sub get_meta($self, $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;
sub import {
my ($package, %opts) = @_;
sub import($package, %opts) {
if (%opts) {
# set import options for package
$import_opts{$package} = \%opts;
}
}
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
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::Core::Utils::LoadModules qw/load_modules/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# registered commands hashtable
$self->{commands} = {};
@ -29,16 +27,13 @@ sub initialize {
}
# load commands in PBot::Core::Commands directory
sub load_commands {
my ($self) = @_;
sub load_commands($self) {
$self->{pbot}->{logger}->log("Loading commands:\n");
load_modules($self, 'PBot::Core::Commands');
}
# named-parameters interface to register()
sub add {
my ($self, %args) = @_;
sub add($self, %args) {
# expected parameters
my @valid = qw(subref name requires_cap help);
@ -66,21 +61,16 @@ sub add {
}
# alias to unregister() for consistency
sub remove {
my $self = shift @_;
$self->unregister(@_);
sub remove($self, @args) {
$self->unregister(@args);
}
sub register {
my ($self, $subref, $name, $requires_cap, $help) = @_;
sub register($self, $subref, $name, $requires_cap = 0, $help = '') {
if (not defined $subref or not defined $name) {
Carp::croak("Missing parameters to Commands::register");
}
$name = lc $name;
$requires_cap //= 0;
$help //= '';
if (exists $self->{commands}->{$name}) {
$self->{pbot}->{logger}->log("Commands: warning: overwriting existing command $name\n");
@ -117,34 +107,28 @@ sub register {
}
}
sub unregister {
my ($self, $name) = @_;
sub unregister($self, $name) {
Carp::croak("Missing name parameter to Commands::unregister") if not defined $name;
delete $self->{commands}->{lc $name};
}
sub exists {
my ($self, $name) = @_;
sub exists($self, $name) {
return exists $self->{commands}->{lc $name};
}
sub set_meta {
my ($self, $command, $key, $value, $save) = @_;
sub set_meta($self, $command, $key, $value, $save = 0) {
return undef if not $self->{metadata}->exists($command);
$self->{metadata}->set($command, $key, $value, !$save);
return 1;
}
sub get_meta {
my ($self, $command, $key) = @_;
sub get_meta($self, $command, $key) {
return $self->{metadata}->get_data($command, $key);
}
# main entry point for PBot::Core::Interpreter to interpret a registered bot command
# see also PBot::Core::Factoids::Interpreter for factoid commands
sub interpreter {
my ($self, $context) = @_;
sub interpreter($self, $context) {
# debug flag to trace $context location and contents
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
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 POSIX qw/strftime/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_antispam(@_) }, "antispam", 1);
# add capability to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-antispam', 1);
}
sub cmd_antispam {
my ($self, $context) = @_;
sub cmd_antispam($self, $context) {
my $arglist = $context->{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 Encode;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# bot commands to load and unload applets
$self->{pbot}->{commands}->register(sub { $self->cmd_load(@_) }, "load", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unload(@_) }, "unload", 1);
}
sub cmd_load {
my ($self, $context) = @_;
sub cmd_load($self, $context) {
my ($keyword, $applet) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: load <keyword> <applet>" if not defined $applet;
@ -44,9 +40,7 @@ sub cmd_load {
return "Loaded applet $keyword => $applet";
}
sub cmd_unload {
my ($self, $context) = @_;
sub cmd_unload($self, $context) {
my $applet = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
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 POSIX qw/strftime/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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_checkmute(@_) }, "checkmute", 0);
@ -30,9 +28,7 @@ sub initialize {
}
sub cmd_banlist {
my ($self, $context) = @_;
sub cmd_banlist($self, $context) {
if (not length $context->{arguments}) {
return "Usage: banlist <channel>";
}
@ -93,8 +89,7 @@ sub cmd_banlist {
return $result;
}
sub cmd_checkban {
my ($self, $context) = @_;
sub cmd_checkban($self, $context) {
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkban <mask> [channel]" if not defined $target;
@ -104,8 +99,7 @@ sub cmd_checkban {
return $self->{pbot}->{banlist}->checkban($channel, 'b', $target);
}
sub cmd_checkmute {
my ($self, $context) = @_;
sub cmd_checkmute($self, $context) {
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
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);
}
sub cmd_unbanme {
my ($self, $context) = @_;
sub cmd_unbanme($self, $context) {
my $unbanned;
my %aliases = $self->{pbot}->{messagehistory}->{database}->get_also_known_as($context->{nick});
@ -226,8 +219,7 @@ sub cmd_unbanme {
}
}
sub cmd_ban_exempt {
my ($self, $context) = @_;
sub cmd_ban_exempt($self, $context) {
my $arglist = $context->{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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_blacklist(@_) }, "blacklist", 1);
# add capability to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-blacklist', 1);
}
sub cmd_blacklist {
my ($self, $context) = @_;
sub cmd_blacklist($self, $context) {
my $arglist = $context->{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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_cap(@_) }, "cap");
}
sub cmd_cap {
my ($self, $context) = @_;
sub cmd_cap($self, $context) {
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
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::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register commands
$self->{pbot}->{commands}->register(sub { $self->cmd_op(@_) }, "op", 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(@_) });
}
sub on_inviting {
my ($self, $event_type, $event) = @_;
sub on_inviting($self, $event_type, $event) {
my ($botnick, $target, $channel) = $event->args;
$self->{pbot}->{logger}->log("User $target invited to channel $channel.\n");
@ -104,9 +100,7 @@ sub on_inviting {
return 1;
}
sub on_useronchannel {
my ($self, $event_type, $event) = @_;
sub on_useronchannel($self, $event_type, $event) {
my ($botnick, $target, $channel) = $event->args;
$self->{pbot}->{logger}->log("User $target is already on channel $channel.\n");
@ -121,9 +115,7 @@ sub on_useronchannel {
return 1;
}
sub on_nosuchnick {
my ($self, $event_type, $event) = @_;
sub on_nosuchnick($self, $event_type, $event) {
my ($botnick, $target, $msg) = $event->args;
$self->{pbot}->{logger}->log("$target: $msg\n");
@ -142,8 +134,7 @@ sub on_nosuchnick {
return 1;
}
sub cmd_invite {
my ($self, $context) = @_;
sub cmd_invite($self, $context) {
my ($channel, $target);
if ($context->{from} !~ m/^#/) {
@ -168,8 +159,7 @@ sub cmd_invite {
return ""; # responses handled by events
}
sub generic_mode {
my ($self, $mode_flag, $mode_name, $context) = @_;
sub generic_mode($self, $mode_flag, $mode_name, $context) {
my $result = '';
my $channel = $context->{from};
@ -220,29 +210,23 @@ sub generic_mode {
return $result;
}
sub cmd_op {
my ($self, $context) = @_;
sub cmd_op($self, $context) {
return $self->generic_mode('+o', 'op', $context);
}
sub cmd_deop {
my ($self, $context) = @_;
sub cmd_deop($self, $context) {
return $self->generic_mode('-o', 'deop', $context);
}
sub cmd_voice {
my ($self, $context) = @_;
sub cmd_voice($self, $context) {
return $self->generic_mode('+v', 'voice', $context);
}
sub cmd_devoice {
my ($self, $context) = @_;
sub cmd_devoice($self, $context) {
return $self->generic_mode('-v', 'devoice', $context);
}
sub cmd_mode {
my ($self, $context) = @_;
sub cmd_mode($self, $context) {
if (not length $context->{arguments}) { return "Usage: mode [channel] <arguments>"; }
# add current channel as default channel
@ -352,8 +336,7 @@ sub cmd_mode {
else { return ""; }
}
sub cmd_ban {
my ($self, $context) = @_;
sub cmd_ban($self, $context) {
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
$channel = '' if not defined $channel;
@ -431,9 +414,7 @@ sub cmd_ban {
return $result;
}
sub cmd_unban {
my ($self, $context) = @_;
sub cmd_unban($self, $context) {
if (not defined $context->{from}) {
$self->{pbot}->{logger}->log("Command missing ~from parameter!\n");
return "";
@ -483,8 +464,7 @@ sub cmd_unban {
return "/msg $context->{nick} $target has been unbanned from $channel.";
}
sub cmd_mute {
my ($self, $context) = @_;
sub cmd_mute($self, $context) {
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
$channel = '' if not defined $channel;
@ -564,9 +544,7 @@ sub cmd_mute {
return $result;
}
sub cmd_unmute {
my ($self, $context) = @_;
sub cmd_unmute($self, $context) {
if (not defined $context->{from}) {
$self->{pbot}->{logger}->log("Command missing ~from parameter!\n");
return "";
@ -613,9 +591,7 @@ sub cmd_unmute {
return "/msg $context->{nick} $target has been unmuted in $channel.";
}
sub cmd_kick {
my ($self, $context) = @_;
sub cmd_kick($self, $context) {
my ($channel, $victim, $reason);
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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register commands
$self->{pbot}->{commands}->register(sub { $self->cmd_join(@_) }, "join", 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);
}
sub cmd_join {
my ($self, $context) = @_;
sub cmd_join($self, $context) {
foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me join $channel\n");
$self->{pbot}->{channels}->join($channel);
@ -37,8 +34,7 @@ sub cmd_join {
return "/msg $context->{nick} Joining $context->{arguments}";
}
sub cmd_part {
my ($self, $context) = @_;
sub cmd_part($self, $context) {
$context->{arguments} = $context->{from} if not $context->{arguments};
foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$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}";
}
sub cmd_set {
my ($self, $context) = @_;
sub cmd_set($self, $context) {
my ($channel, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
return "Usage: chanset <channel> [key [value]]" if not defined $channel;
return $self->{pbot}->{channels}->{storage}->set($channel, $key, $value);
}
sub cmd_unset {
my ($self, $context) = @_;
sub cmd_unset($self, $context) {
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 $self->{pbot}->{channels}->{storage}->unset($channel, $key);
}
sub cmd_add {
my ($self, $context) = @_;
sub cmd_add($self, $context) {
return "Usage: chanadd <channel>" if not length $context->{arguments};
my $data = {
@ -74,8 +67,7 @@ sub cmd_add {
return $self->{pbot}->{channels}->{storage}->add($context->{arguments}, $data);
}
sub cmd_remove {
my ($self, $context) = @_;
sub cmd_remove($self, $context) {
return "Usage: chanrem <channel>" if not length $context->{arguments};
# clear banlists
@ -88,8 +80,7 @@ sub cmd_remove {
return $self->{pbot}->{channels}->{storage}->remove($context->{arguments});
}
sub cmd_list {
my ($self, $context) = @_;
sub cmd_list($self, $context) {
my $result;
foreach my $channel (sort $self->{pbot}->{channels}->{storage}->get_keys) {
$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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register commands to manipulate command metadata
$self->{pbot}->{commands}->register(sub { $self->cmd_set(@_) }, "cmdset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unset(@_) }, "cmdunset", 1);
}
sub cmd_set {
my ($self, $context) = @_;
sub cmd_set($self, $context) {
my ($command, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $command) {
@ -30,9 +26,7 @@ sub cmd_set {
return $self->{pbot}->{commands}->{metadata}->set($command, $key, $value);
}
sub cmd_unset {
my ($self, $context) = @_;
sub cmd_unset($self, $context) {
my ($command, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register `eventqueue` bot command
$self->{pbot}->{commands}->register(sub { $self->cmd_eventqueue(@_) }, 'eventqueue', 1);
@ -22,9 +20,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-eventqueue', 1);
}
sub cmd_eventqueue {
my ($self, $context) = @_;
sub cmd_eventqueue($self, $context) {
my $usage = "Usage: eventqueue list [filter regex] | add <relative time> <command> [-repeat] | remove <regex>";
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});

118
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
);
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{registry}->add_default('text', 'general', 'applet_repo', $conf{applet_repo}
// '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);
}
sub cmd_call_factoid {
my ($self, $context) = @_;
sub cmd_call_factoid($self, $context) {
my ($chan, $keyword, $args) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3, 0, 1);
if (not defined $chan or not defined $keyword) {
@ -92,9 +89,7 @@ sub cmd_call_factoid {
return $self->{pbot}->{factoids}->{interpreter}->interpreter($context);
}
sub cmd_as_factoid {
my ($self, $context) = @_;
sub cmd_as_factoid($self, $context) {
my $arguments = $context->{arguments};
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;
}
sub cmd_factundo {
my ($self, $context) = @_;
sub cmd_factundo($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 $arguments = $context->{arguments};
@ -238,9 +232,7 @@ sub cmd_factundo {
return "[$channel_name] $trigger_name reverted (revision " . ($undos->{idx} + 1) . "): $changes\n";
}
sub cmd_factredo {
my ($self, $context) = @_;
sub cmd_factredo($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 $arguments = $context->{arguments};
@ -332,9 +324,7 @@ sub cmd_factredo {
return "[$channel_name] $trigger_name restored (revision " . ($undos->{idx} + 1) . "): $changes\n";
}
sub cmd_factset {
my ($self, $context) = @_;
sub cmd_factset($self, $context) {
my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel(
$context->{from}, $context->{arguments}, 'factset', usage => 'Usage: factset [channel] <factoid> [key [value]]', explicit => 1
);
@ -430,8 +420,7 @@ sub cmd_factset {
return $result;
}
sub cmd_factunset {
my ($self, $context) = @_;
sub cmd_factunset($self, $context) {
my $usage = 'Usage: factunset [channel] <factoid> <key>';
my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel(
@ -516,9 +505,7 @@ sub cmd_factunset {
return $result;
}
sub cmd_factmove {
my ($self, $context) = @_;
sub cmd_factmove($self, $context) {
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]";
@ -614,8 +601,7 @@ sub cmd_factmove {
}
}
sub cmd_factalias {
my ($self, $context) = @_;
sub cmd_factalias($self, $context) {
my ($chan, $alias, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3, 0, 1);
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);
}
sub cmd_add_regex {
my ($self, $context) = @_;
sub cmd_add_regex($self, $context) {
my ($keyword, $text) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
my $channel = $context->{from};
@ -697,9 +682,7 @@ my @valid_pastesites = (
'https?://0x0.st',
);
sub cmd_factadd {
my ($self, $context) = @_;
sub cmd_factadd($self, $context) {
my ($from_chan, $keyword, $text, $force);
my @arglist = @{$context->{arglist}};
@ -819,8 +802,7 @@ sub cmd_factadd {
return "/say $keyword_text added to " . ($from_chan eq '.*' ? 'global channel' : $from_chan) . ".";
}
sub cmd_factrem {
my ($self, $context) = @_;
sub cmd_factrem($self, $context) {
my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
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);
}
sub cmd_factshow {
my ($self, $context) = @_;
sub cmd_factshow($self, $context) {
my $usage = "Usage: factshow [-p] [channel] <keyword>; -p to paste";
return $usage if not length $context->{arguments};
@ -909,9 +889,7 @@ sub cmd_factshow {
return $result;
}
sub cmd_factlog {
my ($self, $context) = @_;
sub cmd_factlog($self, $context) {
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};
@ -993,8 +971,7 @@ sub cmd_factlog {
return $result;
}
sub cmd_factinfo {
my ($self, $context) = @_;
sub cmd_factinfo($self, $context) {
my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
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.";
}
sub quotemeta2 {
my ($text) = @_;
sub quotemeta2($text) {
$text =~ s/(?<!\\) ([\[ \\ \| () { ^ \$ * + ? . ])/\\$1/gx;
return $text;
}
sub cmd_factfind {
my ($self, $context) = @_;
sub cmd_factfind($self, $context) {
my $arguments = $context->{arguments};
my $usage = "Usage: factfind [-channel channel] [-owner regex] [-editby regex] [-refby regex] [-regex] [text]";
@ -1212,8 +1186,7 @@ sub cmd_factfind {
}
}
sub cmd_factchange {
my ($self, $context) = @_;
sub cmd_factchange($self, $context) {
my $factoids_data = $self->{pbot}->{factoids}->{data}->{storage};
my ($channel, $trigger, $keyword, $delim, $tochange, $changeto, $modifier, $url);
@ -1400,8 +1373,7 @@ sub cmd_factchange {
return "Changed: $trigger_name is $action";
}
sub cmd_top20 {
my ($self, $context) = @_;
sub cmd_top20($self, $context) {
my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my %hash = ();
my $text = "";
@ -1419,7 +1391,8 @@ sub cmd_top20 {
last if $i >= 20;
}
$channel = "the global channel" if $channel eq '.*';
$channel = "the global channel" if $channel eq '.*';
if ($i > 0) {
return "Top $i referenced factoids for $channel: $text";
} else {
@ -1460,8 +1433,7 @@ sub cmd_top20 {
}
}
sub cmd_histogram {
my ($self, $context) = @_;
sub cmd_histogram($self, $context) {
my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my %owners;
my $factoid_count = 0;
@ -1485,8 +1457,7 @@ sub cmd_histogram {
return "/say $factoid_count factoids, top $top submitters:\n$text";
}
sub cmd_count {
my ($self, $context) = @_;
sub cmd_count($self, $context) {
my $factoids = $self->{pbot}->{factoids}->{data}->{storage};
my $i = 0;
my $total = 0;
@ -1518,9 +1489,7 @@ sub cmd_count {
}
}
sub log_factoid {
my ($self, $channel, $trigger, $hostmask, $msg, $dont_save_undo) = @_;
sub log_factoid($self, $channel, $trigger, $hostmask, $msg, $dont_save_undo = 0) {
$channel = lc $channel;
$trigger = lc $trigger;
@ -1568,9 +1537,7 @@ sub log_factoid {
$self->{pbot}->{logger}->log("Error storing undo: $@\n") if $@;
}
sub find_factoid_with_optional_channel {
my ($self, $from, $arguments, $command, %opts) = @_;
sub find_factoid_with_optional_channel($self, $from, $arguments, $command, %opts) {
my %default_opts = (
usage => undef,
explicit => 0,
@ -1667,8 +1634,7 @@ sub find_factoid_with_optional_channel {
return ($channel, $trigger, $remaining_args);
}
sub hash_differences_as_string {
my ($self, $old, $new) = @_;
sub hash_differences_as_string($self, $old, $new) {
my @exclude = qw/created_on last_referenced_in last_referenced_on ref_count ref_user edited_by edited_on/;
my %diff;
@ -1687,35 +1653,45 @@ sub hash_differences_as_string {
my $changes = "";
my $comma = "";
foreach my $key (sort keys %diff) {
if (defined $diff{$key}) { $changes .= "$comma$key => $diff{$key}"; }
else { $changes .= "$comma$key"; }
if (defined $diff{$key}) {
$changes .= "$comma$key => $diff{$key}";
} else {
$changes .= "$comma$key";
}
$comma = ", ";
}
return $changes;
}
sub list_undo_history {
my ($self, $undos, $start_from) = @_;
sub list_undo_history($self, $undos, $start_from = undef) {
$start_from-- if defined $start_from;
$start_from = 0 if not defined $start_from or $start_from < 0;
my $result = "";
if ($start_from > @{$undos->{list}}) {
if (@{$undos->{list}} == 1) { return "But there is only one revision available."; }
else { return "But there are only " . @{$undos->{list}} . " revisions available."; }
if (@{$undos->{list}} == 1) {
return "But there is only one revision available.";
} else {
return "But there are only " . @{$undos->{list}} . " revisions available.";
}
}
if ($start_from == 0) {
if ($undos->{idx} == 0) { $result .= "*1*: "; }
else { $result .= "1: "; }
if ($undos->{idx} == 0) {
$result .= "*1*: ";
} else {
$result .= "1: ";
}
$result .= $self->hash_differences_as_string({}, $undos->{list}->[0]) . ";\n\n";
$start_from++;
}
for (my $i = $start_from; $i < @{$undos->{list}}; $i++) {
if ($i == $undos->{idx}) { $result .= "*" . ($i + 1) . "*: "; }
else { $result .= ($i + 1) . ": "; }
if ($i == $undos->{idx}) {
$result .= "*" . ($i + 1) . "*: ";
} else {
$result .= ($i + 1) . ": ";
}
$result .= $self->hash_differences_as_string($undos->{list}->[$i - 1], $undos->{list}->[$i]);
$result .= ";\n\n";
}

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

@ -21,15 +21,11 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_func(@_) }, 'func', 0);
}
sub cmd_func {
my ($self, $context) = @_;
sub cmd_func($self, $context) {
my $func = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_help(@_) }, 'help');
}
sub cmd_help {
my ($self, $context) = @_;
sub cmd_help($self, $context) {
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]`.";
}

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

@ -12,9 +12,7 @@ use PBot::Imports;
use Time::Duration qw/concise duration/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_ignore(@_) }, "ignore", 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);
}
sub cmd_ignore {
my ($self, $context) = @_;
sub cmd_ignore($self, $context) {
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $target) {
@ -82,9 +78,7 @@ sub cmd_ignore {
return $self->{pbot}->{ignorelist}->add($channel, $target, $length, $context->{hostmask});
}
sub cmd_unignore {
my ($self, $context) = @_;
sub cmd_unignore($self, $context) {
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
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::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_lagcheck(@_) }, "lagcheck", 0);
}
sub cmd_lagcheck {
my ($self, $context) = @_;
sub cmd_lagcheck($self, $context) {
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
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::Duration;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# unprivileged commands
$self->{pbot}->{commands}->register(sub { $self->cmd_list_also_known_as(@_) }, "aka", 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);
}
sub cmd_list_also_known_as {
my ($self, $context) = @_;
sub cmd_list_also_known_as($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";
if (not length $context->{arguments}) {
@ -199,9 +195,7 @@ sub cmd_list_also_known_as {
}
}
sub cmd_recall_message {
my ($self, $context) = @_;
sub cmd_recall_message($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 $arguments = $context->{arguments};
@ -468,14 +462,11 @@ sub cmd_recall_message {
return $result;
}
sub cmd_rebuild_aliases {
my ($self, $context) = @_;
sub cmd_rebuild_aliases($self, $context) {
$self->{pbot}->{messagehistory}->{database}->rebuild_aliases_table;
}
sub cmd_aka_link {
my ($self, $context) = @_;
sub cmd_aka_link($self, $context) {
my ($id, $alias, $type) = split /\s+/, $context->{arguments};
$type = LINK_STRONG if not defined $type;
@ -502,9 +493,7 @@ sub cmd_aka_link {
}
}
sub cmd_aka_unlink {
my ($self, $context) = @_;
sub cmd_aka_unlink($self, $context) {
my ($id, $alias) = split /\s+/, $context->{arguments};
if (not $id or not $alias) {
@ -529,9 +518,7 @@ sub cmd_aka_unlink {
}
}
sub cmd_aka_delete {
my ($self, $context) = @_;
sub cmd_aka_delete($self, $context) {
my $usage = "Usage: akadelete [-hn] <account id or hostmask>; -h delete only hostmask; -n delete only nickserv";
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/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# misc commands
$self->{pbot}->{commands}->register(sub { $self->cmd_nop(@_) }, 'nop', 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);
}
sub cmd_nop {
my ($self, $context) = @_;
sub cmd_nop($self, $context) {
$self->{pbot}->{logger}->log("Disregarding NOP command.\n");
return '';
}
sub cmd_uptime {
my ($self, $context) = @_;
sub cmd_uptime($self, $context) {
return localtime($self->{pbot}->{startup_timestamp}) . ' [' . duration(time - $self->{pbot}->{startup_timestamp}) . ']';
}
sub cmd_in_channel {
my ($self, $context) = @_;
sub cmd_in_channel($self, $context) {
my $usage = 'Usage: in <channel> <command>';
if (not length $context->{arguments}) {
@ -71,8 +65,7 @@ sub cmd_in_channel {
return $self->{pbot}->{interpreter}->interpret($context);
}
sub cmd_list {
my ($self, $context) = @_;
sub cmd_list($self, $context) {
my $text;
my $usage = 'Usage: list <applets|commands>';
@ -110,15 +103,13 @@ sub cmd_list {
return $usage;
}
sub cmd_sl {
my ($self, $context) = @_;
sub cmd_sl($self, $context) {
return "Usage: sl <ircd command>" if not length $context->{arguments};
$self->{pbot}->{conn}->sl($context->{arguments});
return "/msg $context->{nick} sl: command sent. See log for result.";
}
sub cmd_die {
my ($self, $context) = @_;
sub cmd_die($self, $context) {
$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}->quit("Departure requested.") if defined $self->{pbot}->{conn};
@ -126,9 +117,7 @@ sub cmd_die {
exit 0;
}
sub cmd_export {
my ($self, $context) = @_;
sub cmd_export($self, $context) {
my $usage = "Usage: export factoids";
return $usage if not length $context->{arguments};
@ -140,9 +129,7 @@ sub cmd_export {
return $usage;
}
sub cmd_eval {
my ($self, $context) = @_;
sub cmd_eval($self, $context) {
$self->{pbot}->{logger}->log("eval: $context->{from} $context->{hostmask} evaluating `$context->{arguments}`\n");
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::Duration qw/concise ago/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_nicklist(@_) }, "nicklist", 1);
}
sub cmd_nicklist {
my ($self, $context) = @_;
sub cmd_nicklist($self, $context) {
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';

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

@ -12,9 +12,7 @@ use parent 'PBot::Core::Class';
use File::Basename;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# plugin management bot commands
$self->{pbot}->{commands}->register(sub { $self->cmd_plug(@_) }, "plug", 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);
}
sub cmd_plug {
my ($self, $context) = @_;
sub cmd_plug($self, $context) {
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: plug <plugin>"; }
@ -36,9 +32,7 @@ sub cmd_plug {
}
}
sub cmd_unplug {
my ($self, $context) = @_;
sub cmd_unplug($self, $context) {
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: unplug <plugin>"; }
@ -50,9 +44,7 @@ sub cmd_unplug {
}
}
sub cmd_replug {
my ($self, $context) = @_;
sub cmd_replug($self, $context) {
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: replug <plugin>"; }
@ -66,9 +58,7 @@ sub cmd_replug {
return $result;
}
sub cmd_pluglist {
my ($self, $context) = @_;
sub cmd_pluglist($self, $context) {
my @plugins = sort keys %{$self->{pbot}->{plugins}->{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::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# process manager bot commands
$self->{pbot}->{commands}->register(sub { $self->cmd_ps(@_) }, 'ps', 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_kill(@_) }, 'kill', 1);
@ -24,9 +22,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('admin', 'can-kill', 1);
}
sub cmd_ps {
my ($self, $context) = @_;
sub cmd_ps($self, $context) {
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);
@ -82,9 +78,7 @@ sub cmd_ps {
return $result;
}
sub cmd_kill {
my ($self, $context) = @_;
sub cmd_kill($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 ($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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_refresh(@_) }, "refresh", 1);
}
sub cmd_refresh {
my ($self, $context) = @_;
sub cmd_refresh($self, $context) {
my $last_update = $self->{pbot}->{updater}->get_last_update_version;
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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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_regshow(@_) }, "regshow", 0);
@ -21,9 +20,7 @@ sub initialize {
$self->{pbot}->{commands}->register(sub { $self->cmd_regfind(@_) }, "regfind", 0);
}
sub cmd_regset {
my ($self, $context) = @_;
sub cmd_regset($self, $context) {
my $usage = "Usage: regset <section>.<item> [value]";
# support "<section>.<key>" syntax in addition to "<section> <key>"
@ -52,9 +49,7 @@ sub cmd_regset {
return "$section.$item set to $value";
}
sub cmd_regunset {
my ($self, $context) = @_;
sub cmd_regunset($self, $context) {
my $usage = "Usage: regunset <section>.<item>";
# support "<section>.<key>" syntax in addition to "<section> <key>"
@ -86,9 +81,7 @@ sub cmd_regunset {
return "$section.$item deleted from registry";
}
sub cmd_regsetmeta {
my ($self, $context) = @_;
sub cmd_regsetmeta($self, $context) {
my $usage = "Usage: regsetmeta <section>.<item> [key [value]]";
# 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);
}
sub cmd_regunsetmeta {
my ($self, $context) = @_;
sub cmd_regunsetmeta($self, $context) {
my $usage = "Usage: regunsetmeta <section>.<item> <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);
}
sub cmd_regshow {
my ($self, $context) = @_;
sub cmd_regshow($self, $context) {
my $usage = "Usage: regshow <section>.<item>";
my $registry = $self->{pbot}->{registry}->{storage};
@ -176,9 +165,7 @@ sub cmd_regshow {
return $result;
}
sub cmd_regfind {
my ($self, $context) = @_;
sub cmd_regfind($self, $context) {
my $usage = "Usage: regfind [-showvalues] [-section section] <regex>";
my $registry = $self->{pbot}->{registry}->{storage};
@ -262,9 +249,7 @@ sub cmd_regfind {
}
}
sub cmd_regchange {
my ($self, $context) = @_;
sub cmd_regchange($self, $context) {
my ($section, $item, $delim, $tochange, $changeto, $modifier);
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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_reload(@_) }, 'reload', 1);
}
sub cmd_reload {
my ($self, $context) = @_;
sub cmd_reload($self, $context) {
my %reloadables = (
'capabilities' => sub {
$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 parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register commands
$self->{pbot}->{commands}->register(sub { $self->cmd_login(@_) }, "login", 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);
}
sub cmd_login {
my ($self, $context) = @_;
sub cmd_login($self, $context) {
my $channel = $context->{from};
return "Usage: login [channel] password" if not $context->{arguments};
@ -64,8 +60,7 @@ sub cmd_login {
return "/msg $context->{nick} $result";
}
sub cmd_logout {
my ($self, $context) = @_;
sub cmd_logout($self, $context) {
$context->{from} = $context->{arguments} if length $context->{arguments};
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;
@ -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.";
}
sub cmd_users {
my ($self, $context) = @_;
sub cmd_users($self, $context) {
my $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
my $include_global = '';
@ -132,8 +126,7 @@ sub cmd_users {
return $text;
}
sub cmd_useradd {
my ($self, $context) = @_;
sub cmd_useradd($self, $context) {
my ($name, $hostmasks, $channels, $capabilities, $password) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5);
$capabilities //= 'none';
@ -170,9 +163,7 @@ sub cmd_useradd {
return "User added.";
}
sub cmd_userdel {
my ($self, $context) = @_;
sub cmd_userdel($self, $context) {
if (not length $context->{arguments}) { return "Usage: userdel <username>"; }
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});
}
sub cmd_usershow {
my ($self, $context) = @_;
sub cmd_usershow($self, $context) {
my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $name) { return "Usage: usershow <username> [key]"; }
@ -213,9 +202,7 @@ sub cmd_usershow {
return $result;
}
sub cmd_userset {
my ($self, $context) = @_;
sub cmd_userset($self, $context) {
my ($name, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $name) { return "Usage: userset <username> [key [value]]"; }
@ -260,9 +247,7 @@ sub cmd_userset {
return $result;
}
sub cmd_userunset {
my ($self, $context) = @_;
sub cmd_userunset($self, $context) {
my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
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);
}
sub cmd_my {
my ($self, $context) = @_;
sub cmd_my($self, $context) {
my ($key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (defined $value) {
@ -372,9 +356,7 @@ sub cmd_my {
return $result;
}
sub cmd_id {
my ($self, $context) = @_;
sub cmd_id($self, $context) {
my $target = length $context->{arguments} ? $context->{arguments} : $context->{nick};
my ($message_account, $hostmask);

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

@ -13,9 +13,7 @@ use PBot::Imports;
use LWP::UserAgent;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register `version` command
$self->{pbot}->{commands}->register(sub { $self->cmd_version(@_) }, 'version');
@ -27,9 +25,7 @@ sub initialize {
};
}
sub cmd_version {
my ($self, $context) = @_;
sub cmd_version($self, $context) {
my $ratelimit = $self->{pbot}->{registry}->get_value('version', 'check_limit') // 300;
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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# hash table of event handlers
$self->{handlers} = {};
}
@ -31,9 +29,7 @@ sub initialize {
# before any handlers need to consult its list, or depopulated by PARTs, QUITs,
# KICKs, etc, after any other handlers need to consult its list.
sub register_handler {
my ($self, $name, $subref, $priority) = @_;
sub register_handler($self, $name, $subref, $priority = 50) {
# get the package of the calling subroutine
my ($package) = caller(0);
@ -41,7 +37,7 @@ sub register_handler {
my $handler_id = "$package-$name";
my $entry = {
priority => $priority // 50,
priority => $priority,
id => $handler_id,
subref => $subref,
};
@ -61,9 +57,7 @@ sub register_handler {
}
# remove an event handler
sub remove_handler {
my ($self, $name) = @_;
sub remove_handler($self, $name) {
# get the package of the calling subroutine
my ($package) = caller(0);
@ -95,9 +89,7 @@ sub remove_handler {
}
# send an event to its handlers
sub dispatch_event {
my ($self, $name, $data) = @_;
sub dispatch_event($self, $name, $data = undef) {
# debugging flag
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.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::EventQueue;
@ -17,22 +17,18 @@ use PBot::Core::Utils::PriorityQueue;
use Time::HiRes qw/time/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{event_queue} = PBot::Core::Utils::PriorityQueue->new(pbot => $self->{pbot});
}
# returns seconds until upcoming event.
sub duration_until_next_event {
my ($self) = @_;
sub duration_until_next_event($self) {
return 0 if not $self->{event_queue}->count;
return $self->{event_queue}->get_priority(0) - time;
}
# invokes any current events and then returns seconds until upcoming event.
sub do_events {
my ($self) = @_;
sub do_events($self) {
# early-return if no events available
return 0 if not $self->{event_queue}->count;
@ -77,20 +73,12 @@ sub do_events {
}
# check if an event is in the event queue.
sub exists {
my ($self, $id) = @_;
sub exists($self, $id) {
return scalar grep { $_->{id} eq $id } $self->{event_queue}->entries;
}
# adds an event to the event queue, optionally repeating
sub enqueue_event {
my ($self, $subref, $interval, $id, $repeating) = @_;
# default values
$id //= "unnamed (${interval}s $subref)";
$repeating //= 0;
$interval //= 0;
sub enqueue_event($self, $subref, $interval = 0, $id = "unamed (${interval}s $subref)", $repeating = 0) {
# create event structure
my $event = {
id => $id,
@ -111,16 +99,13 @@ sub enqueue_event {
}
# convenient alias to add an event with repeating defaulted to enabled.
sub enqueue {
my ($self, $subref, $interval, $id, $repeating) = @_;
$self->enqueue_event($subref, $interval, $id, $repeating // 1);
sub enqueue($self, $subref, $interval = undef, $id = undef, $repeating = 1) {
$self->enqueue_event($subref, $interval, $id, $repeating);
}
# removes an event from the event queue, optionally invoking it.
# `id` can contain `.*` and `.*?` for wildcard-matching/globbing.
sub dequeue_event {
my ($self, $id, $execute) = @_;
sub dequeue_event($self, $id, $execute = 0) {
my $result = eval {
# escape special characters
$id = quotemeta $id;
@ -172,23 +157,19 @@ sub dequeue_event {
}
# alias to dequeue_event, for consistency.
sub dequeue {
my ($self, $id) = @_;
sub dequeue($self, $id) {
$self->dequeue_event($id);
}
# invoke and remove all events matching `id`, which can
# contain `.*` and `.*?` for wildcard-matching/globbing.
sub execute_and_dequeue_event {
my ($self, $id) = @_;
sub execute_and_dequeue_event($self, $id) {
return $self->dequeue_event($id, 1);
}
# replace code subrefs for matching events. if no events
# were found, then add the event to the event queue.
sub replace_subref_or_enqueue_event {
my ($self, $subref, $interval, $id, $repeating) = @_;
sub replace_subref_or_enqueue_event($self, $subref, $interval, $id, $repeating = 0) {
# find events matching id
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.
sub replace_or_enqueue_event {
my ($self, $subref, $interval, $id, $repeating) = @_;
sub replace_or_enqueue_event($self, $subref, $interval, $id, $repeating = 0) {
# remove event if it exists
$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.
sub enqueue_event_unless_exists {
my ($self, $subref, $interval, $id, $repeating) = @_;
sub enqueue_event_unless_exists($self, $subref, $interval, $id, $repeating = 0) {
# event already exists, bail out
return if $self->exists($id);
@ -227,9 +204,7 @@ sub enqueue_event_unless_exists {
}
# update the `repeating` flag for all events matching `id`.
sub update_repeating {
my ($self, $id, $repeating) = @_;
sub update_repeating($self, $id, $repeating) {
foreach my $event ($self->{event_queue}->entries) {
if ($event->{id} eq $id) {
$event->{repeating} = $repeating;
@ -238,9 +213,7 @@ sub update_repeating {
}
# update the `interval` value for all events matching `id`.
sub update_interval {
my ($self, $id, $interval, $dont_enqueue) = @_;
sub update_interval($self, $id, $interval, $dont_enqueue = 0) {
for (my $i = 0; $i < $self->{event_queue}->count; $i++) {
my $event = $self->{event_queue}->get($i);
@ -258,13 +231,11 @@ sub update_interval {
}
}
sub count {
my ($self) = @_;
sub count($self) {
return $self->{event_queue}->count;
}
sub entries {
my ($self) = @_;
sub entries($self) {
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::Variables;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{data} = PBot::Core::Factoids::Data->new(%conf);
$self->{data}->load;

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

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

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

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

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

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

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

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

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

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

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

@ -23,9 +23,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register `list` and `help` functions used to list
# functions and obtain help about them
@ -48,21 +46,15 @@ sub initialize {
);
}
sub register {
my ($self, $func, $data) = @_;
sub register($self, $func, $data) {
$self->{funcs}->{$func} = $data;
}
sub unregister {
my ($self, $func) = @_;
sub unregister($self, $func) {
delete $self->{funcs}->{$func};
}
sub func_list {
my ($self, $regex) = @_;
$regex //= '.*';
sub func_list($self, $regex = '.*') {
my $result = eval {
my @funcs;
@ -94,9 +86,7 @@ sub func_list {
return $result;
}
sub func_help {
my ($self, $func) = @_;
sub func_help($self, $func) {
if (not length $func) {
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::Core::Utils::LoadModules qw/load_modules/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->load_handlers(%conf);
}
sub load_handlers {
my ($self, %conf) = @_;
sub load_handlers($self, %conf) {
$self->{pbot}->{logger}->log("Loading handlers:\n");
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::Duration;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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.quietlist', sub { $self->on_quietlist_entry(@_) });
@ -27,9 +26,7 @@ sub initialize {
}
# typically, immediately after joining a channel...
sub on_endofnames {
my ($self, $event_type, $event) = @_;
sub on_endofnames($self, $event_type, $event) {
my $channel = lc $event->{args}[1];
$self->{pbot}->{logger}->log("Retrieving banlist for $channel.\n");
@ -49,9 +46,7 @@ sub on_endofnames {
return 1;
}
sub on_banlist_entry {
my ($self, $event_type, $event) = @_;
sub on_banlist_entry($self, $event_type, $event) {
my $channel = lc $event->{args}[1];
my $target = lc $event->{args}[2];
my $source = lc $event->{args}[3];
@ -63,9 +58,7 @@ sub on_banlist_entry {
return 1;
}
sub on_quietlist_entry {
my ($self, $event_type, $event) = @_;
sub on_quietlist_entry($self, $event_type, $event) {
my $channel = lc $event->{args}[1];
my $target = lc $event->{args}[3];
my $source = lc $event->{args}[4];
@ -78,8 +71,7 @@ sub on_quietlist_entry {
return 1;
}
sub on_endofbanlist {
my ($self, $event_type, $event) = @_;
sub on_endofbanlist($self, $event_type, $event) {
my $channel = lc $event->{args}[1];
# first check for saved bans no longer in channel
@ -140,8 +132,7 @@ sub on_endofbanlist {
return 1;
}
sub on_endofquietlist {
my ($self, $event_type, $event) = @_;
sub on_endofquietlist($self, $event_type, $event) {
my $channel = lc $event->{args}[1];
my $mute_char = $self->{mute_char};
@ -181,9 +172,7 @@ sub on_endofquietlist {
return 1;
}
sub on_modeflag {
my ($self, $event_type, $event) = @_;
sub on_modeflag($self, $event_type, $event) {
my ($source, $channel, $mode, $mask) = (
$event->{source},
$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/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# IRCv3 client capabilities
$self->{pbot}->{event_dispatcher}->register_handler('irc.cap', sub { $self->on_cap(@_) });
}
# TODO: CAP NEW and CAP DEL
sub on_cap {
my ($self, $event_type, $event) = @_;
sub on_cap($self, $event_type, $event) {
if ($event->{args}[0] eq 'LS') {
my $capabilities;
my $caps_listed = 0;
@ -88,9 +84,7 @@ sub on_cap {
return 1;
}
sub request_caps {
my ($self, $event) = @_;
sub request_caps($self, $event) {
# configure client capabilities that PBot currently supports
my %desired_caps = (
'account-notify' => 1,

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

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

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

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

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

@ -10,18 +10,14 @@ package PBot::Core::Handlers::Chat;
use PBot::Imports;
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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.caction', sub { $self->on_action (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.msg', sub { $self->on_msg (@_) });
}
sub on_notice {
my ($self, $event_type, $event) = @_;
sub on_notice($self, $event_type, $event) {
my ($nick, $user, $host, $to, $text) = (
$event->nick,
$event->user,
@ -49,9 +45,7 @@ sub on_notice {
return 1;
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($from, $nick, $user, $host, $text, $tags) = (
$event->{to}[0],
$event->nick,
@ -69,9 +63,7 @@ sub on_public {
return 1;
}
sub on_action {
my ($self, $event_type, $event) = @_;
sub on_action($self, $event_type, $event) {
# prepend "/me " to the message text
$event->{args}[0] = "/me " . $event->{args}[0];
@ -80,9 +72,7 @@ sub on_action {
return 1;
}
sub on_msg {
my ($self, $event_type, $event) = @_;
sub on_msg($self, $event_type, $event) {
my ($nick, $user, $host, $text, $tags) = (
$event->nick,
$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/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# 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
@ -37,8 +35,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) }, 0);
}
sub on_namreply {
my ($self, $event_type, $event) = @_;
sub on_namreply($self, $event_type, $event) {
my ($channel, $nicks) = ($event->{args}[2], $event->{args}[3]);
foreach my $nick (split ' ', $nicks) {
@ -67,9 +64,7 @@ sub on_namreply {
return 1;
}
sub on_activity {
my ($self, $event_type, $event) = @_;
sub on_activity($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->{to}[0]);
$self->{pbot}->{nicklist}->update_timestamp($channel, $nick);
@ -77,9 +72,7 @@ sub on_activity {
return 1;
}
sub on_join {
my ($self, $event_type, $event) = @_;
sub on_join($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
$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, 'user', $user);
$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;
}
sub on_part {
my ($self, $event_type, $event) = @_;
sub on_part($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
$self->{pbot}->{nicklist}->remove_nick($channel, $nick);
@ -102,9 +93,7 @@ sub on_part {
return 1;
}
sub on_quit {
my ($self, $event_type, $event) = @_;
sub on_quit($self, $event_type, $event) {
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) {
@ -116,9 +105,7 @@ sub on_quit {
return 1;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
sub on_kick($self, $event_type, $event) {
my ($nick, $channel) = ($event->to, $event->{args}[0]);
$self->{pbot}->{nicklist}->remove_nick($channel, $nick);
@ -126,8 +113,7 @@ sub on_kick {
return 1;
}
sub on_nickchange {
my ($self, $event_type, $event) = @_;
sub on_nickchange($self, $event_type, $event) {
my ($nick, $user, $host, $newnick) = ($event->nick, $event->user, $event->host, $event->args);
foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) {
@ -144,9 +130,7 @@ sub on_nickchange {
return 1;
}
sub on_modeflag {
my ($self, $event_type, $event) = @_;
sub on_modeflag($self, $event_type, $event) {
my ($source, $channel, $mode, $target) = (
$event->{source},
$event->{channel},
@ -168,15 +152,13 @@ sub on_modeflag {
return 1;
}
sub on_self_join {
my ($self, $event_type, $event) = @_;
sub on_self_join($self, $event_type, $event) {
# clear nicklist to remove any stale nicks before repopulating with namreplies
$self->{pbot}->{nicklist}->remove_channel($event->{channel});
return 1;
}
sub on_self_part {
my ($self, $event_type, $event) = @_;
sub on_self_part($self, $event_type, $event) {
$self->{pbot}->{nicklist}->remove_channel($event->{channel});
return 1;
}

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

@ -10,9 +10,7 @@ package PBot::Core::Handlers::NickServ;
use PBot::Imports;
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# NickServ-related IRC events get priority 10
# 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);
@ -20,9 +18,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse (@_) }, 10);
}
sub on_welcome {
my ($self, $event_type, $event) = @_;
sub on_welcome($self, $event_type, $event) {
# if not using SASL, identify the old way by msging NickServ or some services bot
if (not $self->{pbot}->{irc_capabilities}->{sasl}) {
if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) {
@ -57,9 +53,7 @@ sub on_welcome {
return undef;
}
sub on_notice {
my ($self, $event_type, $event) = @_;
sub on_notice($self, $event_type, $event) {
my ($nick, $user, $host, $to, $text) = (
$event->nick,
$event->user,
@ -107,9 +101,7 @@ sub on_notice {
return undef;
}
sub on_nicknameinuse {
my ($self, $event_type, $event) = @_;
sub on_nicknameinuse($self, $event_type, $event) {
my (undef, $nick, $msg) = $event->args;
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 MIME::Base64;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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_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 (@_) });
}
sub on_sasl_authenticate {
my ($self, $event_type, $event) = @_;
sub on_sasl_authenticate($self, $event_type, $event) {
my $nick = $self->{pbot}->{registry}->get_value('irc', 'identify_nick'); # try identify_nick
$nick //= $self->{pbot}->{registry}->get_value('irc', 'botnick'); # fallback to botnick
my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password');
@ -59,57 +55,48 @@ sub on_sasl_authenticate {
return 1;
}
sub on_rpl_loggedin {
my ($self, $event_type, $event) = @_;
sub on_rpl_loggedin($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[3] . "\n");
return 1;
}
sub on_rpl_loggedout {
my ($self, $event_type, $event) = @_;
sub on_rpl_loggedout($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
return 1;
}
sub on_err_nicklocked {
my ($self, $event_type, $event) = @_;
sub on_err_nicklocked($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE);
}
sub on_rpl_saslsuccess {
my ($self, $event_type, $event) = @_;
sub on_rpl_saslsuccess($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$event->{conn}->sl("CAP END");
return 1;
}
sub on_err_saslfail {
my ($self, $event_type, $event) = @_;
sub on_err_saslfail($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE);
}
sub on_err_sasltoolong {
my ($self, $event_type, $event) = @_;
sub on_err_sasltoolong($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE);
}
sub on_err_saslaborted {
my ($self, $event_type, $event) = @_;
sub on_err_saslaborted($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
$self->{pbot}->exit(EXIT_FAILURE);
}
sub on_err_saslalready {
my ($self, $event_type, $event) = @_;
sub on_err_saslalready($self, $event_type, $event) {
$self->{pbot}->{logger}->log($event->{args}[1] . "\n");
return 1;
}
sub on_rpl_saslmechs {
my ($self, $event_type, $event) = @_;
sub on_rpl_saslmechs($self, $event_type, $event) {
$self->{pbot}->{logger}->log("SASL mechanism not available.\n");
$self->{pbot}->{logger}->log("Available mechanisms are: $event->{args}[1]\n");
$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/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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.motd', sub { $self->on_motd (@_) });
@ -33,17 +31,14 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.chghost', sub { $self->on_chghost (@_) });
}
sub on_init {
my ($self, $conn, $event) = @_;
sub on_init($self, $conn, $event) {
my (@args) = ($event->args);
shift @args;
$self->{pbot}->{logger}->log("*** @args\n");
return 1;
}
sub on_welcome {
my ($self, $event_type, $event) = @_;
sub on_welcome($self, $event_type, $event) {
$self->{pbot}->{logger}->log("Welcome!\n");
if ($self->{pbot}->{irc_capabilities}->{sasl}) {
@ -55,9 +50,7 @@ sub on_welcome {
return 1;
}
sub on_disconnect {
my ($self, $event_type, $event) = @_;
sub on_disconnect($self, $event_type, $event) {
$self->{pbot}->{logger}->log("Disconnected...\n");
$self->{pbot}->{conn} = undef;
@ -73,9 +66,7 @@ sub on_disconnect {
return 1;
}
sub on_motd {
my ($self, $event_type, $event) = @_;
sub on_motd($self, $event_type, $event) {
if ($self->{pbot}->{registry}->get_value('irc', 'show_motd')) {
my $from = $event->{from};
my $msg = $event->{args}[1];
@ -85,9 +76,7 @@ sub on_motd {
return 1;
}
sub on_notice {
my ($self, $event_type, $event) = @_;
sub on_notice($self, $event_type, $event) {
my ($server, $to, $text) = (
$event->nick,
$event->to,
@ -103,9 +92,7 @@ sub on_notice {
return 1;
}
sub on_isupport {
my ($self, $event_type, $event) = @_;
sub on_isupport($self, $event_type, $event) {
# remove and discard first and last arguments
# (first arg is botnick, last arg is "are supported by this server")
shift @{$event->{args}};
@ -131,8 +118,7 @@ sub on_isupport {
return 1;
}
sub on_nickchange {
my ($self, $event_type, $event) = @_;
sub on_nickchange($self, $event_type, $event) {
my ($nick, $user, $host, $newnick) = ($event->nick, $event->user, $event->host, $event->args);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
@ -167,9 +153,7 @@ sub on_nickchange {
return 1;
}
sub on_nononreg {
my ($self, $event_type, $event) = @_;
sub on_nononreg($self, $event_type, $event) {
my $target = $event->{args}[1];
$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;
}
sub on_chghost {
my ($self, $event_type, $event) = @_;
sub on_chghost($self, $event_type, $event) {
my $nick = $event->nick;
my $user = $event->user;
my $host = $event->host;
@ -212,14 +194,12 @@ sub on_chghost {
return 1;
}
sub log_first_arg {
my ($self, $event_type, $event) = @_;
sub log_first_arg($self, $event_type, $event) {
$self->{pbot}->{logger}->log("$event->{args}[1]\n");
return 1;
}
sub log_third_arg {
my ($self, $event_type, $event) = @_;
sub log_third_arg($self, $event_type, $event) {
$self->{pbot}->{logger}->log("$event->{args}[3]\n");
return 1;
}

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

@ -10,8 +10,7 @@ package PBot::Core::Handlers::Users;
use PBot::Imports;
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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.quit', sub { $self->on_departure (@_) });
@ -19,9 +18,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part (@_) });
}
sub on_join {
my ($self, $event_type, $event) = @_;
sub on_join($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = (
$event->nick,
$event->user,
@ -65,24 +62,21 @@ sub on_join {
return 1;
}
sub on_departure {
my ($self, $event_type, $event) = @_;
sub on_departure($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host");
return 1;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
sub on_kick($self, $event_type, $event) {
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);
$self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host");
return 1;
}
sub on_self_part {
my ($self, $event_type, $event) = @_;
sub on_self_part($self, $event_type, $event) {
delete $self->{pbot}->{users}->{user_cache}->{lc $event->{channel}};
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
# the event to the rest of PBot via PBot::Core::EventDispatcher.
sub default_handler {
my ($self, $conn, $event) = @_;
sub default_handler($self, $conn, $event) {
# add conn to event object so we can access it within handlers
$event->{conn} = $conn;
@ -42,10 +39,7 @@ sub default_handler {
}
# registers handlers with a PBot::Core::IRC connection
sub add_handlers {
my ($self) = @_;
sub add_handlers($self) {
# set up handlers for the IRC engine
$self->{pbot}->{conn}->add_default_handler(
sub { $self->default_handler(@_) }, 1);
@ -71,10 +65,7 @@ sub add_handlers {
}
# replace randomized gibberish in certain hostmasks with identifying information
sub normalize_hostmask {
my ($self, $nick, $user, $host) = @_;
sub normalize_hostmask($self, $nick, $user, $host) {
if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) {
$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/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{filename} = $conf{filename};
$self->{storage} = PBot::Core::Storage::DualIndexHashObject->new(
@ -27,8 +25,7 @@ sub initialize {
$self->enqueue_ignores;
}
sub enqueue_ignores {
my ($self) = @_;
sub enqueue_ignores($self) {
my $now = time;
foreach my $channel ($self->{storage}->get_keys) {
@ -47,9 +44,7 @@ sub enqueue_ignores {
}
}
sub add {
my ($self, $channel, $hostmask, $length, $owner) = @_;
sub add($self, $channel, $hostmask, $length, $owner) {
if ($hostmask !~ /!/) {
$hostmask .= '!*@*';
} elsif ($hostmask !~ /@/) {
@ -89,9 +84,7 @@ sub add {
return "$hostmask ignored for $duration";
}
sub remove {
my ($self, $channel, $hostmask) = @_;
sub remove($self, $channel, $hostmask) {
if ($hostmask !~ /!/) {
$hostmask .= '!*@*';
} elsif ($hostmask !~ /@/) {
@ -104,9 +97,7 @@ sub remove {
return $self->{storage}->remove($channel, $hostmask);
}
sub is_ignored {
my ($self, $channel, $hostmask) = @_;
sub is_ignored($self, $channel, $hostmask) {
return 0 if $self->{pbot}->{users}->loggedin_admin($channel, $hostmask);
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 Unicode::Truncate;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# PBot::Core::Interpreter can register multiple interpreter subrefs.
# See also: Commands::interpreter() and Factoids::interpreter()
$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
# and to execute those commands and process their output
sub process_line {
my ($self, $from, $nick, $user, $host, $text, $tags, $is_command) = @_;
sub process_line($self, $from, $nick, $user, $host, $text, $tags = '', $is_command = 0) {
# lowercase `from` field for case-insensitivity
$from = lc $from;
@ -250,9 +246,7 @@ sub process_line {
# main entry point to interpret/execute a bot command.
# takes a $context object containing contextual information about the
# command such as the channel, nick, user, host, command, etc.
sub interpret {
my ($self, $context) = @_;
sub interpret($self, $context) {
# log command invocation
$self->{pbot}->{logger}->log("=== [$context->{interpret_depth}] Got command: "
. "($context->{from}) $context->{hostmask}: $context->{command}\n");
@ -555,12 +549,8 @@ sub interpret {
# finalizes processing on a command.
# updates pipes, substitutions, splits. truncates to paste site.
# sends final command output to appropriate queues.
sub handle_result {
my ($self, $context, $result) = @_;
# use context result if no result argument given
$result //= $context->{result};
# use context result if no result argument given.
sub handle_result($self, $context, $result = $context->{result}) {
# ensure we have a command result to work with
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.
# $paste_text is the version of text (e.g. with whitespace formatting preserved, etc)
# to send to the paste site.
sub truncate_result {
my ($self, $context, $text, $paste_text) = @_;
sub truncate_result($self, $context, $text, $paste_text) {
my $max_msg_len = $self->{pbot}->{registry}->get_value('irc', 'max_msg_len');
$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 {
my ($self, $line, $channel) = @_;
sub dehighlight_nicks($self, $line, $channel) {
return $line if $self->{pbot}->{registry}->get_value('general', 'no_dehighlight_nicks');
my @tokens = split / /, $line;
@ -832,9 +821,7 @@ sub dehighlight_nicks {
return join ' ', @tokens;
}
sub output_result {
my ($self, $context) = @_;
sub output_result($self, $context) {
# debug flag to trace $context location and contents
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
use Data::Dumper;
@ -943,9 +930,7 @@ sub output_result {
}
}
sub add_message_to_output_queue {
my ($self, $channel, $message, $delay) = @_;
sub add_message_to_output_queue($self, $channel, $message, $delay = 0) {
$self->{pbot}->{event_queue}->enqueue_event(
sub {
my $context = {
@ -965,9 +950,7 @@ sub add_message_to_output_queue {
);
}
sub add_to_command_queue {
my ($self, $channel, $command, $delay, $repeating) = @_;
sub add_to_command_queue($self, $channel, $command, $delay = 0, $repeating = 0) {
$self->{pbot}->{event_queue}->enqueue_event(
sub {
my $context = {
@ -994,9 +977,7 @@ sub add_to_command_queue {
);
}
sub add_botcmd_to_command_queue {
my ($self, $channel, $command, $delay) = @_;
sub add_botcmd_to_command_queue($self, $channel, $command, $delay = 0) {
my $botcmd = {
nick => $self->{pbot}->{registry}->get_value('irc', 'botnick'),
user => 'stdin',
@ -1012,15 +993,7 @@ sub add_botcmd_to_command_queue {
# extracts a bracketed substring, gracefully handling unbalanced quotes
# or brackets. opening and closing brackets may each be more than one character.
# optional prefix may be or begin with a character group.
sub extract_bracketed {
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;
sub extract_bracketed($self, $string, $open_bracket = '{', $close_bracket = '}', $optional_prefix = '', $allow_whitespace = 0) {
my @prefix_group;
if ($optional_prefix =~ s/^\[(.*?)\]//) { @prefix_group = split //, $1; }
@ -1178,9 +1151,7 @@ sub extract_bracketed {
# whitespace or json separators.
# handles unbalanced quotes gracefully by treating them as
# part of the argument they were found within.
sub split_line {
my ($self, $line, %opts) = @_;
sub split_line($self, $line, %opts) {
my %default_opts = (
strip_quotes => 0,
keep_spaces => 0,
@ -1292,9 +1263,7 @@ sub split_line {
}
# creates an array of arguments from a string
sub make_args {
my ($self, $string) = @_;
sub make_args($self, $string) {
my @args = $self->split_line($string, keep_spaces => 1);
my @arglist;
@ -1328,44 +1297,37 @@ sub make_args {
}
# returns size of array of arguments
sub arglist_size {
my ($self, $args) = @_;
sub arglist_size($self, $args) {
return @$args / 2;
}
# unshifts new argument to front
sub unshift_arg {
my ($self, $args, $arg) = @_;
sub unshift_arg($self, $args, $arg) {
splice @$args, @$args / 2, 0, $arg; # add quoted argument
unshift @$args, $arg; # add first argument
return @$args;
}
# shifts first argument off array of arguments
sub shift_arg {
my ($self, $args) = @_;
sub shift_arg($self, $args) {
return undef if not @$args;
splice @$args, @$args / 2, 1; # remove original quoted argument
return shift @$args;
}
# returns list of unquoted arguments
sub unquoted_args {
my ($self, $args) = @_;
sub unquoted_args($self, $args) {
return undef if not @$args;
return @$args[0 .. @$args / 2 - 1];
}
# 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")
sub split_args {
my ($self, $args, $count, $offset, $preserve_quotes) = @_;
sub split_args($self, $args, $count, $offset = 0, $preserve_quotes = 0) {
my @result;
my $max = $self->arglist_size($args);
$preserve_quotes //= 0;
my $i = $offset // 0;
my $i = $offset;
unless ($count == 1) {
do {
my $arg = $args->[$i++];
@ -1390,33 +1352,26 @@ sub split_args {
}
# lowercases array of arguments
sub lc_args {
my ($self, $args) = @_;
sub lc_args($self, $args) {
for (my $i = 0; $i < @$args; $i++) { $args->[$i] = lc $args->[$i]; }
}
# getopt boilerplate in one place
# 99% of our getopt use is on a string
sub getopt {
my $self = shift;
$self->getopt_from_string(@_);
sub getopt($self, @args) {
$self->getopt_from_string(@args);
}
# getopt_from_string() uses our split_line() function instead of
# Getopt::Long::GetOptionsFromString's Text::ParseWords
sub getopt_from_string {
my ($self, $string, $result, $config, @opts) = @_;
sub getopt_from_string($self, $string, $result, $config, @opts) {
my @opt_args = $self->split_line($string, strip_quotes => 1);
return $self->getopt_from_array(\@opt_args, $result, $config, @opts);
}
# the workhorse getopt function
sub getopt_from_array {
my ($self, $opt_args, $result, $config, @opts) = @_;
sub getopt_from_array($self, $opt_args, $result, $config, @opts) {
# emitting errors as Perl warnings instead of using die, weird.
my $opt_error;
local $SIG{__WARN__} = sub {
@ -1425,9 +1380,7 @@ sub getopt_from_array {
};
Getopt::Long::Configure(@$config);
GetOptionsFromArray($opt_args, $result, @opts);
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::Duration;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# average of entries in lag history, in seconds
$self->{lag_average} = undef;
@ -56,14 +54,11 @@ sub initialize {
}
# registry trigger fires when value changes
sub trigger_lag_history_interval {
my ($self, $section, $item, $newvalue) = @_;
sub trigger_lag_history_interval($self, $section, $item, $newvalue) {
$self->{pbot}->{event_queue}->update_interval('lag check', $newvalue);
}
sub send_ping {
my $self = shift;
sub send_ping($self) {
return unless defined $self->{pbot}->{conn};
$self->{ping_send_time} = [gettimeofday];
@ -72,17 +67,13 @@ sub send_ping {
$self->{pbot}->{conn}->sl("PING :lagcheck");
}
sub on_pong {
my $self = shift;
sub on_pong($self, $event_type, $event) {
$self->{pong_received} = 1;
my $elapsed = tv_interval($self->{ping_send_time});
push @{$self->{lag_history}}, [$self->{ping_send_time}[0], $elapsed * 1000];
my $len = @{$self->{lag_history}};
my $lag_history_max = $self->{pbot}->{registry}->get_value('lagchecker', 'lag_history_max');
while ($len > $lag_history_max) {
@ -97,44 +88,30 @@ sub on_pong {
foreach my $entry (@{$self->{lag_history}}) {
my ($send_time, $lag_result) = @$entry;
$lag_total += $lag_result;
my $ago = concise ago(gettimeofday - $send_time);
push @entries, "[$ago] " . sprintf "%.1f ms", $lag_result;
}
$self->{lag_string} = join '; ', @entries;
$self->{lag_average} = $lag_total / $len;
$self->{lag_string} .= "; average: " . sprintf "%.1f ms", $self->{lag_average};
return 0;
}
sub lagging {
my ($self) = @_;
sub lagging($self) {
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
my $elapsed = tv_interval($self->{ping_send_time});
return $elapsed >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
}
return 0 if not defined $self->{lag_average};
return $self->{lag_average} >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
}
sub lagstring {
my ($self) = @_;
my $lag = $self->{lag_string} || "initializing";
return $lag;
sub lagstring($self) {
return $self->{lag_string} || "initializing";
}
1;

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

@ -15,8 +15,7 @@ use File::Copy;
use Time::HiRes qw/gettimeofday/;
use POSIX;
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot};
@ -25,9 +24,7 @@ sub new {
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# ensure logfile path was provided
$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 });
}
sub log {
my ($self, $text) = @_;
sub log($self, $text) {
# get current time
my ($sec, $usec) = gettimeofday;
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'};
}
sub rotate_log {
my ($self) = @_;
sub rotate_log($self) {
# get start time
my $time = localtime $self->{start};
$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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3';
$self->{database} = PBot::Core::MessageHistory::Storage::SQLite->new(
@ -35,13 +34,11 @@ sub initialize {
$self->{pbot}->{atexit}->register(sub { $self->{database}->end });
}
sub get_message_account {
my ($self, $nick, $user, $host) = @_;
sub get_message_account($self, $nick, $user, $host) {
return $self->{database}->get_message_account($nick, $user, $host);
}
sub add_message {
my ($self, $account, $mask, $channel, $text, $mode) = @_;
sub add_message($self, $account, $mask, $channel, $text, $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 Time::Duration;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3';
$self->{new_entries} = 0;
@ -49,14 +47,11 @@ sub initialize {
'messagehistory commit');
}
sub sqlite_commit_interval_trigger {
my ($self, $section, $item, $newvalue) = @_;
sub sqlite_commit_interval_trigger($self, $section, $item, $newvalue) {
$self->{pbot}->{event_queue}->update_interval('messagehistory commit', $newvalue);
}
sub sqlite_debug_trigger {
my ($self, $section, $item, $newvalue) = @_;
sub sqlite_debug_trigger($self, $section, $item, $newvalue) {
if ($newvalue) {
open $self->{trace_layer}, '>:via(PBot::Core::Utils::SQLiteLoggerLayer)', PBot::Core::Utils::SQLiteLogger->new(pbot => $self->{pbot});
} else {
@ -67,9 +62,7 @@ sub sqlite_debug_trigger {
$self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh};
}
sub begin {
my $self = shift;
sub begin($self) {
$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})
@ -170,9 +163,7 @@ SQL
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub end {
my $self = shift;
sub end($self) {
$self->{pbot}->{logger}->log("Closing message history SQLite database\n");
if (exists $self->{dbh} and defined $self->{dbh}) {
@ -183,9 +174,7 @@ sub end {
}
}
sub get_gecos {
my ($self, $id) = @_;
sub get_gecos($self, $id) {
my $gecos = eval {
my $sth = $self->{dbh}->prepare('SELECT gecos FROM Gecos WHERE id = ?');
$sth->execute($id);
@ -195,9 +184,7 @@ sub get_gecos {
return map { $_->[0] } @$gecos;
}
sub get_nickserv_accounts {
my ($self, $id) = @_;
sub get_nickserv_accounts($self, $id) {
my $nickserv_accounts = eval {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Nickserv WHERE id = ?');
$sth->execute($id);
@ -207,9 +194,7 @@ sub get_nickserv_accounts {
return map { $_->[0] } @$nickserv_accounts;
}
sub delete_nickserv_accounts {
my ($self, $id) = @_;
sub delete_nickserv_accounts($self, $id) {
eval {
$self->{dbh}->do('DELETE FROM Nickserv WHERE id = ?', undef, $id);
$self->{dbh}->commit;
@ -224,9 +209,7 @@ sub delete_nickserv_accounts {
return 1;
}
sub set_current_nickserv_account {
my ($self, $id, $nickserv) = @_;
sub set_current_nickserv_account($self, $id, $nickserv) {
eval {
my $sth = $self->{dbh}->prepare('UPDATE Accounts SET nickserv = ? WHERE id = ?');
$sth->execute($nickserv, $id);
@ -239,9 +222,7 @@ sub set_current_nickserv_account {
}
}
sub get_current_nickserv_account {
my ($self, $id) = @_;
sub get_current_nickserv_account($self, $id) {
my $nickserv = eval {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Accounts WHERE id = ?');
$sth->execute($id);
@ -252,9 +233,7 @@ sub get_current_nickserv_account {
return $nickserv;
}
sub create_nickserv {
my ($self, $id, $nickserv) = @_;
sub create_nickserv($self, $id, $nickserv) {
eval {
my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Nickserv VALUES (?, ?, 0)');
$sth->execute($id, $nickserv);
@ -263,9 +242,7 @@ sub create_nickserv {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub update_nickserv_account {
my ($self, $id, $nickserv, $timestamp) = @_;
sub update_nickserv_account($self, $id, $nickserv, $timestamp) {
$self->create_nickserv($id, $nickserv);
eval {
@ -276,9 +253,7 @@ sub update_nickserv_account {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub create_gecos {
my ($self, $id, $gecos) = @_;
sub create_gecos($self, $id, $gecos) {
eval {
my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO Gecos VALUES (?, ?, 0)');
my $rv = $sth->execute($id, $gecos);
@ -287,9 +262,7 @@ sub create_gecos {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub update_gecos {
my ($self, $id, $gecos, $timestamp) = @_;
sub update_gecos($self, $id, $gecos, $timestamp) {
$self->create_gecos($id, $gecos);
eval {
@ -300,9 +273,7 @@ sub update_gecos {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub add_message_account {
my ($self, $mask, $link_id, $link_type) = @_;
sub add_message_account($self, $mask, $link_id = undef, $link_type = undef) {
my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/;
my $id;
@ -339,9 +310,7 @@ sub add_message_account {
return $id;
}
sub find_message_account_by_id {
my ($self, $id) = @_;
sub find_message_account_by_id($self, $id) {
my $hostmask = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmask FROM Hostmasks WHERE id = ? ORDER BY last_seen DESC LIMIT 1');
$sth->execute($id);
@ -353,9 +322,7 @@ sub find_message_account_by_id {
return $hostmask;
}
sub find_message_account_by_nick {
my ($self, $nick) = @_;
sub find_message_account_by_nick($self, $nick) {
my ($id, $hostmask) = eval {
my $sth = $self->{dbh}->prepare('SELECT id, hostmask FROM Hostmasks WHERE nick = ? ORDER BY last_seen DESC LIMIT 1');
$sth->execute($nick);
@ -367,9 +334,7 @@ sub find_message_account_by_nick {
return ($id, $hostmask);
}
sub find_message_accounts_by_nickserv {
my ($self, $nickserv) = @_;
sub find_message_accounts_by_nickserv($self, $nickserv) {
my $accounts = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Nickserv WHERE nickserv = ? ORDER BY timestamp DESC');
$sth->execute($nickserv);
@ -379,11 +344,7 @@ sub find_message_accounts_by_nickserv {
return map { $_->[0] } @$accounts;
}
sub find_message_accounts_by_mask {
my ($self, $mask, $limit) = @_;
$limit //= 100;
sub find_message_accounts_by_mask($self, $mask, $limit = 100) {
my $qmask = quotemeta $mask;
$qmask =~ s/_/\\_/g;
$qmask =~ s/\\\./_/g;
@ -400,16 +361,13 @@ sub find_message_accounts_by_mask {
return map { $_->[0] } @$accounts;
}
sub get_message_account_ancestor {
my $self = shift;
my $id = $self->get_message_account(@_);
sub get_message_account_ancestor($self, @args) {
my $id = $self->get_message_account(@args);
$id = $self->get_ancestor_id($id);
return $id;
}
sub get_message_account {
my ($self, $nick, $user, $host, $orig_nick) = @_;
sub get_message_account($self, $nick, $user, $host, $orig_nick = undef) {
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
=cut
@ -801,9 +759,7 @@ sub get_message_account {
return $self->add_message_account($mask);
}
sub find_most_recent_hostmask {
my ($self, $id) = @_;
sub find_most_recent_hostmask($self, $id) {
my $hostmask = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmask FROM Hostmasks WHERE ID = ? ORDER BY last_seen DESC LIMIT 1');
$sth->execute($id);
@ -814,9 +770,7 @@ sub find_most_recent_hostmask {
return $hostmask;
}
sub update_hostmask_data {
my ($self, $mask, $data) = @_;
sub update_hostmask_data($self, $mask, $data) {
eval {
my $sql = 'UPDATE Hostmasks SET ';
@ -840,9 +794,7 @@ sub update_hostmask_data {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub get_nickserv_accounts_for_hostmask {
my ($self, $hostmask) = @_;
sub get_nickserv_accounts_for_hostmask($self, $hostmask) {
my $nickservs = eval {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Hostmasks, Nickserv WHERE nickserv.id = hostmasks.id AND hostmasks.hostmask = ?');
$sth->execute($hostmask);
@ -853,9 +805,7 @@ sub get_nickserv_accounts_for_hostmask {
return map { $_->[0] } @$nickservs;
}
sub get_gecos_for_hostmask {
my ($self, $hostmask) = @_;
sub get_gecos_for_hostmask($self, $hostmask) {
my $gecos = eval {
my $sth = $self->{dbh}->prepare('SELECT gecos FROM Hostmasks, Gecos WHERE gecos.id = hostmasks.id AND hostmasks.hostmask = ?');
$sth->execute($hostmask);
@ -866,9 +816,7 @@ sub get_gecos_for_hostmask {
return map { $_->[0] } @$gecos;
}
sub get_hostmasks_for_channel {
my ($self, $channel) = @_;
sub get_hostmasks_for_channel($self, $channel) {
my $hostmasks = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmasks.id, hostmask FROM Hostmasks, Channels WHERE channels.id = hostmasks.id AND channel = ?');
$sth->execute($channel);
@ -879,9 +827,7 @@ sub get_hostmasks_for_channel {
return $hostmasks;
}
sub get_hostmasks_for_nickserv {
my ($self, $nickserv) = @_;
sub get_hostmasks_for_nickserv($self, $nickserv) {
my $hostmasks = eval {
my $sth = $self->{dbh}->prepare('SELECT hostmasks.id, hostmask, nickserv FROM Hostmasks, Nickserv WHERE nickserv.id = hostmasks.id AND nickserv = ?');
$sth->execute($nickserv);
@ -892,9 +838,7 @@ sub get_hostmasks_for_nickserv {
return $hostmasks;
}
sub add_message {
my ($self, $id, $hostmask, $channel, $message) = @_;
sub add_message($self, $id, $hostmask, $channel, $message) {
eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Messages VALUES (?, ?, ?, ?, ?, ?)');
$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 }});
}
sub get_recent_messages {
my ($self, $id, $channel, $limit, $mode, $nick) = @_;
$limit //= 25;
sub get_recent_messages($self, $id, $channel, $limit = 25, $mode = undef, $nick = undef) {
$channel = lc $channel;
my $mode_query = '';
@ -962,12 +902,7 @@ sub get_recent_messages {
return $messages;
}
sub get_recent_messages_from_channel {
my ($self, $channel, $limit, $mode, $direction) = @_;
$limit //= 25;
$direction //= 'ASC';
sub get_recent_messages_from_channel($self, $channel, $limit = 25, $mode = undef, $direction = 'ASC') {
$channel = lc $channel;
my $mode_query = '';
@ -983,9 +918,7 @@ sub get_recent_messages_from_channel {
return $messages;
}
sub get_message_context {
my ($self, $message, $before, $after, $count, $text, $context_id, $context_nick) = @_;
sub get_message_context($self, $message, $before = undef, $after = undef, $count = undef, $text = undef, $context_id = undef, $context_nick = undef) {
my %seen_id;
my $ids = '';
@ -1079,9 +1012,7 @@ sub get_message_context {
return \@messages;
}
sub recall_message_by_count {
my ($self, $id, $channel, $count, $ignore_command, $use_aliases) = @_;
sub recall_message_by_count($self, $id, $channel, $count, $ignore_command = undef, $use_aliases = undef) {
my $messages = eval {
my $sql = 'SELECT * FROM Messages WHERE ';
@ -1141,9 +1072,7 @@ sub recall_message_by_count {
return $messages->[0];
}
sub recall_message_by_text {
my ($self, $id, $channel, $text, $ignore_command, $use_aliases) = @_;
sub recall_message_by_text($self, $id, $channel, $text, $ignore_command = undef, $use_aliases = undef) {
my $search = "%$text%";
$search =~ s/(?<!\\)\.?\*/%/g;
$search =~ s/(?<!\\)\?/_/g;
@ -1212,9 +1141,7 @@ sub recall_message_by_text {
return $messages->[0];
}
sub get_random_message {
my ($self, $id, $channel, $use_aliases) = @_;
sub get_random_message($self, $id, $channel, $use_aliases = undef) {
my $message = eval {
my $sql = 'SELECT * FROM Messages WHERE channel = ? AND mode = ? ';
@ -1266,9 +1193,7 @@ sub get_random_message {
return $message;
}
sub get_max_messages {
my ($self, $id, $channel, $use_aliases) = @_;
sub get_max_messages($self, $id, $channel, $use_aliases = undef) {
my $count = eval {
my $sql = 'SELECT COUNT(*) FROM Messages WHERE channel = ? AND ';
@ -1313,9 +1238,7 @@ sub get_max_messages {
return $count;
}
sub create_channel {
my ($self, $id, $channel) = @_;
sub create_channel($self, $id, $channel) {
eval {
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);
@ -1324,9 +1247,7 @@ sub create_channel {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub get_channels {
my ($self, $id) = @_;
sub get_channels($self, $id) {
my $channels = eval {
my $sth = $self->{dbh}->prepare('SELECT channel FROM Channels WHERE id = ?');
$sth->execute($id);
@ -1336,9 +1257,7 @@ sub get_channels {
return map { $_->[0] } @$channels;
}
sub get_channel_data {
my ($self, $id, $channel, @columns) = @_;
sub get_channel_data($self, $id, $channel, @columns) {
$self->create_channel($id, $channel);
my $channel_data = eval {
@ -1362,9 +1281,7 @@ sub get_channel_data {
return $channel_data;
}
sub update_channel_data {
my ($self, $id, $channel, $data) = @_;
sub update_channel_data($self, $id, $channel, $data) {
$self->create_channel($id, $channel);
eval {
@ -1391,9 +1308,7 @@ sub update_channel_data {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub get_channel_datas_where_last_offense_older_than {
my ($self, $timestamp) = @_;
sub get_channel_datas_where_last_offense_older_than($self, $timestamp) {
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 <= ?');
$sth->execute($timestamp);
@ -1403,9 +1318,7 @@ sub get_channel_datas_where_last_offense_older_than {
return $channel_datas;
}
sub get_channel_datas_with_enter_abuses {
my ($self) = @_;
sub get_channel_datas_with_enter_abuses($self) {
my $channel_datas = eval {
my $sth = $self->{dbh}->prepare('SELECT id, channel, enter_abuses, last_offense FROM Channels WHERE enter_abuses > 0');
$sth->execute();
@ -1415,11 +1328,7 @@ sub get_channel_datas_with_enter_abuses {
return $channel_datas;
}
sub devalidate_channel {
my ($self, $id, $channel, $mode) = @_;
$mode = 0 if not defined $mode;
sub devalidate_channel($self, $id, $channel, $mode = 0) {
eval {
my $sth = $self->{dbh}->prepare("UPDATE Channels SET validated = ? WHERE id = ? AND channel = ?");
$sth->execute($mode, $id, $channel);
@ -1428,11 +1337,7 @@ sub devalidate_channel {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub devalidate_all_channels {
my ($self, $id, $mode) = @_;
$mode = 0 if not defined $mode;
sub devalidate_all_channels($self, $id = undef, $mode = 0) {
my $where = '';
$where = 'WHERE id = ?' if defined $id;
@ -1446,9 +1351,7 @@ sub devalidate_all_channels {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub link_aliases {
my ($self, $account, $hostmask, $nickserv) = @_;
sub link_aliases($self, $account, $hostmask = undef, $nickserv = undef) {
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;
@ -1555,9 +1458,7 @@ sub link_aliases {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub link_alias {
my ($self, $id, $alias, $type, $force) = @_;
sub link_alias($self, $id, $alias, $type = undef, $force = undef) {
my $debug_link = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_link');
$self->{pbot}->{logger}
@ -1621,9 +1522,7 @@ sub link_alias {
return $ret;
}
sub unlink_alias {
my ($self, $id, $alias) = @_;
sub unlink_alias($self, $id, $alias) {
my $ret = eval {
my $ret = 0;
my $sth = $self->{dbh}->prepare('DELETE FROM Aliases WHERE id = ? AND alias = ?');
@ -1647,9 +1546,7 @@ sub unlink_alias {
return $ret;
}
sub delete_hostmask {
my ($self, $id, $hostmask) = @_;
sub delete_hostmask($self, $id, $hostmask) {
eval {
$self->{dbh}->do('DELETE FROM Hostmasks WHERE id = ? AND hostmask = ?', undef, $id, $hostmask);
$self->{dbh}->commit;
@ -1664,9 +1561,7 @@ sub delete_hostmask {
return 1;
}
sub delete_account {
my ($self, $id) = @_;
sub delete_account($self, $id) {
$self->{dbh}->commit;
$self->{dbh}->begin_work;
@ -1694,9 +1589,7 @@ sub delete_account {
return $ret;
}
sub vacuum {
my $self = shift;
sub vacuum($self) {
eval { $self->{dbh}->commit(); };
$self->{pbot}->{logger}->log("SQLite error $@ when committing $self->{new_entries} entries.\n") if $@;
@ -1707,9 +1600,7 @@ sub vacuum {
$self->{new_entries} = 0;
}
sub rebuild_aliases_table {
my $self = shift;
sub rebuild_aliases_table($self) {
eval {
$self->{dbh}->do('DELETE FROM Aliases');
$self->vacuum;
@ -1737,8 +1628,7 @@ sub rebuild_aliases_table {
$self->{pbot}->{logger}->log("EXCEPT: $@\n") if $@;
}
sub get_also_known_as {
my ($self, $nick, $dont_use_aliases_table) = @_;
sub get_also_known_as($self, $nick, $dont_use_aliases_table = undef) {
my $debug = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_aka');
$self->{pbot}->{logger}->log("[AKA] Checking nick $nick\n") if $debug;
@ -1946,11 +1836,7 @@ sub get_also_known_as {
return %akas;
}
sub get_ancestor_id {
my ($self, $id) = @_;
$id = 0 if not defined $id;
sub get_ancestor_id($self, $id = 0) {
my $ancestor = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Aliases WHERE alias = ? ORDER BY id LIMIT 1');
$sth->execute($id);
@ -1966,9 +1852,7 @@ sub get_ancestor_id {
# End of public API, the remaining are internal support routines for this module
sub get_new_account_id {
my $self = shift;
sub get_new_account_id($self) {
my $id = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Accounts ORDER BY id DESC LIMIT 1');
$sth->execute();
@ -1980,9 +1864,7 @@ sub get_new_account_id {
return ++$id;
}
sub get_message_account_id {
my ($self, $mask) = @_;
sub get_message_account_id($self, $mask) {
my $id = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Hostmasks WHERE hostmask == ?');
$sth->execute($mask);
@ -1994,9 +1876,7 @@ sub get_message_account_id {
return $id;
}
sub commit_message_history {
my ($self) = @_;
sub commit_message_history($self) {
return if not $self->{dbh};
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 Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# nicklist hashtable
$self->{nicklist} = {};
@ -25,9 +23,7 @@ sub initialize {
$self->{pbot}->{registry}->add_default('text', 'nicklist', 'debug', '0');
}
sub update_timestamp {
my ($self, $channel, $nick) = @_;
sub update_timestamp($self, $channel, $nick) {
my $orig_nick = $nick;
$channel = lc $channel;
@ -40,14 +36,11 @@ sub update_timestamp {
$self->{nicklist}->{$channel}->{$nick}->{timestamp} = gettimeofday;
}
sub remove_channel {
my ($self, $channel) = @_;
sub remove_channel($self, $channel) {
delete $self->{nicklist}->{lc $channel};
}
sub add_nick {
my ($self, $channel, $nick) = @_;
sub add_nick($self, $channel, $nick) {
if (not exists $self->{nicklist}->{lc $channel}->{lc $nick}) {
if ($self->{pbot}->{registry}->get_value('nicklist', 'debug')) {
$self->{pbot}->{logger}->log("Adding nick '$nick' to channel '$channel'\n");
@ -56,18 +49,14 @@ sub add_nick {
}
}
sub remove_nick {
my ($self, $channel, $nick) = @_;
sub remove_nick($self, $channel, $nick) {
if ($self->{pbot}->{registry}->get_value('nicklist', 'debug')) {
$self->{pbot}->{logger}->log("Removing nick '$nick' from channel '$channel'\n");
}
delete $self->{nicklist}->{lc $channel}->{lc $nick};
}
sub get_channels {
my ($self, $nick) = @_;
sub get_channels($self, $nick) {
$nick = lc $nick;
my @channels;
@ -81,9 +70,7 @@ sub get_channels {
return \@channels;
}
sub get_nicks {
my ($self, $channel) = @_;
sub get_nicks($self, $channel) {
$channel = lc $channel;
my @nicks;
@ -97,9 +84,7 @@ sub get_nicks {
return @nicks;
}
sub set_meta {
my ($self, $channel, $nick, $key, $value) = @_;
sub set_meta($self, $channel, $nick, $key, $value) {
$channel = lc $channel;
$nick = lc $nick;
@ -130,9 +115,7 @@ sub set_meta {
return 1;
}
sub delete_meta {
my ($self, $channel, $nick, $key) = @_;
sub delete_meta($self, $channel, $nick, $key) {
$channel = lc $channel;
$nick = lc $nick;
@ -143,9 +126,7 @@ sub delete_meta {
return delete $self->{nicklist}->{$channel}->{$nick}->{$key};
}
sub get_meta {
my ($self, $channel, $nick, $key) = @_;
sub get_meta($self, $channel, $nick, $key) {
$channel = lc $channel;
$nick = lc $nick;
@ -156,9 +137,7 @@ sub get_meta {
return $self->{nicklist}->{$channel}->{$nick}->{$key};
}
sub is_present_any_channel {
my ($self, $nick) = @_;
sub is_present_any_channel($self, $nick) {
$nick = lc $nick;
foreach my $channel (keys %{$self->{nicklist}}) {
@ -170,9 +149,7 @@ sub is_present_any_channel {
return 0;
}
sub is_present {
my ($self, $channel, $nick) = @_;
sub is_present($self, $channel, $nick) {
$channel = lc $channel;
$nick = lc $nick;
@ -183,9 +160,7 @@ sub is_present {
}
}
sub is_present_similar {
my ($self, $channel, $nick, $similarity) = @_;
sub is_present_similar($self, $channel, $nick, $similarity = undef) {
$channel = lc $channel;
$nick = lc $nick;
@ -228,9 +203,7 @@ sub is_present_similar {
return 0;
}
sub random_nick {
my ($self, $channel) = @_;
sub random_nick($self, $channel) {
$channel = lc $channel;
if (exists $self->{nicklist}->{$channel}) {

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

@ -12,9 +12,7 @@ use PBot::Imports;
use File::Basename;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# loaded plugins
$self->{plugins} = {};
@ -22,9 +20,7 @@ sub initialize {
$self->autoload(%conf);
}
sub autoload {
my ($self, %conf) = @_;
sub autoload($self, %conf) {
return if $self->{pbot}->{registry}->get_value('plugins', 'noautoload');
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");
}
sub load {
my ($self, $plugin, %conf) = @_;
sub load($self, $plugin, %conf) {
$self->unload($plugin);
return if $self->{pbot}->{registry}->get_value('plugins', 'disabled');
@ -91,9 +85,7 @@ sub load {
return $ret;
}
sub unload {
my ($self, $plugin) = @_;
sub unload($self, $plugin) {
if (exists $self->{plugins}->{$plugin}) {
eval {
$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 JSON;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# hash of currently running bot-invoked processes
$self->{processes} = {};
@ -27,9 +25,7 @@ sub initialize {
};
}
sub add_process {
my ($self, $pid, $context) = @_;
sub add_process($self, $pid, $context) {
$context->{process_start} = gettimeofday;
$self->{processes}->{$pid} = $context;
@ -37,9 +33,7 @@ sub add_process {
$self->{pbot}->{logger}->log("Starting process $pid: $context->{commands}->[0]\n");
}
sub remove_process {
my ($self, $pid) = @_;
sub remove_process($self, $pid) {
if (exists $self->{processes}->{$pid}) {
my $command = $self->{processes}->{$pid}->{commands}->[0];
@ -54,11 +48,7 @@ sub remove_process {
}
}
sub execute_process {
my ($self, $context, $subref, $timeout, $reader_subref) = @_;
$timeout //= 30; # default timeout 30 seconds
sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref = undef) {
# ensure contextual command history list is available for add_process()
if (not exists $context->{commands}) {
$context->{commands} = [$context->{command}];
@ -110,7 +100,7 @@ sub execute_process {
# execute the provided subroutine, results are stored in $context
eval {
local $SIG{ALRM} = sub { die "Process `$context->{commands}->[0]` timed-out\n" };
alarm $timeout;
alarm ($timeout // 30);
$subref->($context);
alarm 0;
};
@ -152,9 +142,7 @@ sub execute_process {
}
}
sub process_pipe_reader {
my ($self, $pid, $buf) = @_;
sub process_pipe_reader($self, $pid, $buf) {
# retrieve context object from child
my $context = decode_json $buf or do {
$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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{refresher} = Module::Refresh->new;
}

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

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

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

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

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

@ -15,9 +15,7 @@ sub initialize {
# nothing to initialize
}
sub add_reader {
my ($self, $handle, $subref) = @_;
sub add_reader($self, $handle, $subref) {
# add file handle to PBot::Core::IRC's select loop
$self->{pbot}->{irc}->addfh($handle, sub { $self->on_select_read($handle, $subref) }, 'r');
@ -25,9 +23,7 @@ sub add_reader {
$self->{buffers}->{$handle} = '';
}
sub remove_reader {
my ($self, $handle) = @_;
sub remove_reader($self, $handle) {
# remove file handle from PBot::Core::IRC's select loop
$self->{pbot}->{irc}->removefh($handle);
@ -35,9 +31,7 @@ sub remove_reader {
delete $self->{buffers}->{$handle};
}
sub on_select_read {
my ($self, $handle, $subref) = @_;
sub on_select_read($self, $handle, $subref) {
# maximum read length
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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# create stdin bot-admin account for bot
my $user = $self->{pbot}->{users}->find_user('.*', '*!stdin@pbot');
@ -47,9 +45,7 @@ sub initialize {
}
}
sub stdin_reader {
my ($self, $input) = @_;
sub stdin_reader($self, $input) {
# make sure we're in the foreground first
$self->{foreground} = (tcgetpgrp($self->{tty_fd}) == getpgrp()) ? 1 : 0;
return if not $self->{foreground};

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

@ -22,8 +22,7 @@ use PBot::Imports;
use Text::Levenshtein::XS qw(distance);
use JSON;
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot};
@ -31,16 +30,14 @@ sub new {
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$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->{save_queue_timeout} = $conf{save_queue_timeout} // 0;
$self->{hash} = {};
}
sub load {
my ($self, $filename) = @_;
sub load($self, $filename = undef) {
$filename = $self->{filename} if not defined $filename;
if (not defined $filename) {
@ -96,11 +93,10 @@ sub load {
}
}
sub save {
my $self = shift;
sub save($self, @args) {
my $filename;
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (@args) { $filename = shift @args; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
Carp::carp "No $self->{name} filename specified -- skipping saving to file.\n";
@ -137,18 +133,14 @@ sub save {
}
}
sub clear {
my $self = shift;
sub clear($self) {
$self->{hash} = {};
}
sub levenshtein_matches {
my ($self, $primary_index, $secondary_index, $distance, $strictnamespace) = @_;
sub levenshtein_matches($self, $primary_index, $secondary_index, $distance = 0.60, $strictnamespace = 0) {
my $comma = '';
my $result = "";
$distance = 0.60 if not defined $distance;
$primary_index = '.*' if not defined $primary_index;
if (not $secondary_index) {
@ -205,8 +197,7 @@ sub levenshtein_matches {
return $result;
}
sub set {
my ($self, $primary_index, $secondary_index, $key, $value, $dont_save) = @_;
sub set($self, $primary_index, $secondary_index, $key = undef, $value = undef, $dont_save = 0) {
my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index;
@ -241,8 +232,9 @@ sub set {
return $result;
}
if (not defined $value) { $value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key}; }
else {
if (not defined $value) {
$value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key};
} else {
$self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key} = $value;
$self->save unless $dont_save;
}
@ -250,8 +242,7 @@ sub set {
return "[$name1] $name2: $key " . (defined $value ? "set to $value" : "is not set.");
}
sub unset {
my ($self, $primary_index, $secondary_index, $key) = @_;
sub unset($self, $primary_index, $secondary_index, $key) {
my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index;
@ -282,8 +273,7 @@ sub unset {
$self->save;
}
sub exists {
my ($self, $primary_index, $secondary_index, $data_index) = @_;
sub exists($self, $primary_index = undef, $secondary_index = undef, $data_index = undef) {
return 0 if not defined $primary_index;
$primary_index = lc $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};
}
sub get_key_name {
my ($self, $primary_index, $secondary_index) = @_;
sub get_key_name($self, $primary_index, $secondary_index = undef) {
my $lc_primary_index = 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 {
my ($self, $primary_index, $secondary_index) = @_;
sub get_keys($self, $primary_index = undef, $secondary_index = undef) {
return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $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}};
}
sub get_data {
my ($self, $primary_index, $secondary_index, $data_index) = @_;
$primary_index = lc $primary_index if defined $primary_index;
sub get_data($self, $primary_index, $secondary_index = undef, $data_index = undef) {
$primary_index = lc $primary_index;
$secondary_index = lc $secondary_index if defined $secondary_index;
return undef if not exists $self->{hash}->{$primary_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};
}
sub add {
my ($self, $primary_index, $secondary_index, $data, $dont_save, $quiet) = @_;
sub add($self, $primary_index, $secondary_index, $data, $dont_save = 0, $quiet = 0) {
my $lc_primary_index = lc $primary_index;
my $lc_secondary_index = lc $secondary_index;
@ -386,8 +371,7 @@ sub add {
return "$self->{name}: [$name1]: $name2 added.";
}
sub remove {
my ($self, $primary_index, $secondary_index, $data_index, $dont_save) = @_;
sub remove($self, $primary_index, $secondary_index = undef, $data_index = undef, $dont_save = 0) {
my $lc_primary_index = lc $primary_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 Text::Levenshtein::XS qw(distance);
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
my $self = bless {}, $class;
$self->{pbot} = delete $args{pbot};
@ -35,9 +34,7 @@ sub new {
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{name} = $conf{name} // 'Dual Index SQLite object';
$self->{filename} = $conf{filename} // Carp::croak("Missing filename in " . __FILE__);
@ -54,15 +51,12 @@ sub initialize {
$self->begin;
}
sub sqlite_debug_trigger {
my ($self, $section, $item, $newvalue) = @_;
sub sqlite_debug_trigger($self, $section, $item, $newvalue) {
return if not defined $self->{dbh};
$self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue"));
}
sub begin {
my ($self) = @_;
sub begin($self) {
$self->{pbot}->{logger}->log("Opening $self->{name} database ($self->{filename})\n");
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", undef, undef,
@ -80,9 +74,7 @@ sub begin {
}
}
sub end {
my ($self) = @_;
sub end($self) {
$self->{pbot}->{logger}->log("Closing $self->{name} database ($self->{filename})\n");
if (defined $self->{dbh}) {
@ -95,14 +87,12 @@ sub end {
$self->{pbot}->{event_queue}->dequeue("Trim $self->{name} cache");
}
sub load {
my ($self) = @_;
sub load ($self) {
$self->create_database;
$self->create_cache;
}
sub save {
my ($self) = @_;
sub save($self) {
return if not $self->{dbh};
eval { $self->{dbh}->commit };
@ -112,9 +102,7 @@ sub save {
}
}
sub create_database {
my ($self) = @_;
sub create_database($self) {
eval {
$self->{dbh}->do(<<SQL);
CREATE TABLE IF NOT EXISTS Stuff (
@ -129,9 +117,7 @@ SQL
$self->{pbot}->{logger}->log("Error creating $self->{name} databse: $@") if $@;
}
sub create_cache {
my ($self) = @_;
sub create_cache($self) {
$self->{cache} = {};
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");
}
sub cache_remove {
my ($self, $index1, $index2) = @_;
sub cache_remove($self, $index1, $index2 = undef) {
if (not defined $index2) {
# remove index1
delete $self->{cache}->{$index1};
@ -181,9 +165,7 @@ sub cache_remove {
}
}
sub enqueue_decache {
my ($self, $index1, $index2) = @_;
sub enqueue_decache($self, $index1, $index2) {
my $timeout = $self->{pbot}->{registry}->get_value('dualindexsqliteobject', 'cache_timeout') // 60 * 30;
$self->{pbot}->{event_queue}->enqueue_event(
@ -200,15 +182,12 @@ sub enqueue_decache {
);
}
sub dequeue_decache {
my ($self, $index1, $index2) = @_;
sub dequeue_decache($self, $index1, $index2) {
my $key = ($index1 eq '.*' ? 'global' : $index1) . ".$index2";
$self->{pbot}->{event_queue}->dequeue("Decache $self->{name} $key");
}
sub create_metadata {
my ($self, $columns) = @_;
sub create_metadata($self, $columns) {
return if not $self->{dbh};
$self->{columns} = $columns;
@ -234,12 +213,7 @@ sub create_metadata {
}
}
sub levenshtein_matches {
my ($self, $index1, $index2, $distance, $strictnamespace) = @_;
$index1 //= '.*';
$distance //= 0.60;
sub levenshtein_matches($self, $index1 = '.*', $index2 = undef, $distance = 0.60, $strictnamespace = 0) {
my $output = 'none';
if (not $index2) {
@ -321,8 +295,7 @@ sub levenshtein_matches {
return $output;
}
sub exists {
my ($self, $index1, $index2, $data_index) = @_;
sub exists($self, $index1 = undef, $index2 = undef, $data_index = undef) {
return 0 if not defined $index1;
$index1 = lc $index1;
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);
}
sub get_keys {
my ($self, $index1, $index2, $nocache) = @_;
sub get_keys($self, $index1 = undef, $index2 = undef, $nocache = 0) {
my @keys;
if (not defined $index1) {
@ -428,9 +399,7 @@ sub get_keys {
return @keys;
}
sub get_each {
my ($self, @opts) = @_;
sub get_each($self, @opts) {
my $sth = eval {
my $sql = 'SELECT ';
my @keys = ();
@ -536,9 +505,7 @@ sub get_each {
return $sth;
}
sub get_next {
my ($self, $sth) = @_;
sub get_next($self, $sth) {
my $data = eval {
return $sth->fetchrow_hashref;
};
@ -551,9 +518,7 @@ sub get_next {
return $data;
}
sub get_all {
my ($self, @opts) = @_;
sub get_all($self, @opts) {
my $sth = $self->get_each(@opts);
my $data = eval {
@ -568,9 +533,7 @@ sub get_all {
return @$data;
}
sub get_key_name {
my ($self, $index1, $index2) = @_;
sub get_key_name($self, $index1, $index2 = undef) {
my $lc_index1 = lc $index1;
if (not exists $self->{cache}->{$lc_index1}) {
@ -598,9 +561,7 @@ sub get_key_name {
}
}
sub get_data {
my ($self, $index1, $index2, $data_index) = @_;
sub get_data($self, $index1, $index2, $data_index = undef) {
my $lc_index1 = lc $index1;
my $lc_index2 = lc $index2;
@ -687,9 +648,7 @@ sub get_data {
return $value;
}
sub add {
my ($self, $index1, $index2, $data, $quiet) = @_;
sub add($self, $index1, $index2, $data, $quiet = 0) {
my $name1 = $self->get_data($index1, '_name') // $index1;
eval {
@ -762,9 +721,7 @@ sub add {
return "$index2 added to $name1.";
}
sub remove {
my ($self, $index1, $index2, $data_index, $dont_save) = @_;
sub remove($self, $index1, $index2 = undef, $data_index = undef, $dont_save = 0) {
if (not $self->exists($index1)) {
my $result = "$self->{name}: $index1 not found; similiar matches: ";
$result .= $self->levenshtein_matches($index1);
@ -846,9 +803,7 @@ sub remove {
return "$name2.$data_index is not set.";
}
sub set {
my ($self, $index1, $index2, $key, $value) = @_;
sub set($self, $index1, $index2, $key = undef, $value = undef) {
if (not $self->exists($index1)) {
my $result = "$self->{name}: $index1 not found; similiar matches: ";
$result .= $self->levenshtein_matches($index1);
@ -919,9 +874,7 @@ sub set {
return "[$name1] $name2.$key " . (defined $value ? "set to $value" : "is not set.");
}
sub unset {
my ($self, $index1, $index2, $key) = @_;
sub unset($self, $index1, $index2, $key) {
if (not $self->exists($index1)) {
my $result = "$self->{name}: $index1 not found; similiar matches: ";
$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 JSON;
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
my $self = bless {}, $class;
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $args{pbot};
$self->{pbot} = delete $args{pbot};
@ -27,9 +26,7 @@ sub new {
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{name} = $conf{name} // 'unnammed';
$self->{hash} = {};
$self->{filename} = $conf{filename};
@ -39,9 +36,7 @@ sub initialize {
}
}
sub load {
my ($self, $filename) = @_;
sub load($self, $filename = undef) {
# allow overriding $self->{filename} with $filename parameter
$filename //= $self->{filename};
@ -100,9 +95,7 @@ sub load {
}
}
sub save {
my ($self, $filename) = @_;
sub save($self, $filename = undef) {
# allow parameter overriding internal field
$filename //= $self->{filename};
@ -132,14 +125,11 @@ sub save {
close(FILE);
}
sub clear {
my ($self) = @_;
sub clear($self) {
$self->{hash} = {};
}
sub levenshtein_matches {
my ($self, $keyword) = @_;
sub levenshtein_matches($self, $keyword) {
my @matches;
foreach my $index (sort keys %{$self->{hash}}) {
@ -165,8 +155,7 @@ sub levenshtein_matches {
return $result;
}
sub set {
my ($self, $index, $key, $value, $dont_save) = @_;
sub set($self, $index, $key = undef, $value = undef, $dont_save = 0) {
my $lc_index = lc $index;
# 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.");
}
sub unset {
my ($self, $index, $key) = @_;
sub unset($self, $index, $key = undef) {
my $lc_index = lc $index;
if (not exists $self->{hash}->{$lc_index}) {
@ -225,35 +213,30 @@ sub unset {
}
}
sub exists {
my ($self, $index, $data_index) = @_;
sub exists($self, $index, $data_index = undef) {
return exists $self->{hash}->{lc $index} if not defined $data_index;
return exists $self->{hash}->{lc $index}->{$data_index};
}
sub get_key_name {
my ($self, $index) = @_;
sub get_key_name($self, $index) {
my $lc_index = 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;
}
sub get_keys {
my ($self, $index) = @_;
sub get_keys($self, $index = undef) {
return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $index;
return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $index}};
}
sub get_data {
my ($self, $index, $data_index) = @_;
sub get_data($self, $index, $data_index = undef) {
my $lc_index = 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}->{$data_index};
}
sub add {
my ($self, $index, $data, $dont_save) = @_;
sub add($self, $index, $data, $dont_save = 0) {
my $lc_index = lc $index;
# preserve case of index
@ -266,8 +249,7 @@ sub add {
return "$index added to $self->{name}.";
}
sub remove {
my ($self, $index, $data_index, $dont_save) = @_;
sub remove($self, $index, $data_index = undef, $dont_save = 0) {
my $lc_index = 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;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{data_dir} = $conf{data_dir};
$self->{update_dir} = $conf{update_dir};
}
sub update {
my ($self) = @_;
sub update($self) {
$self->{pbot}->{logger}->log("Checking if update needed...\n");
my $current_version = $self->get_current_version;
@ -58,8 +55,7 @@ sub update {
return $self->put_last_update_version($current_version);
}
sub get_available_updates {
my ($self, $last_update_version) = @_;
sub get_available_updates($self, $last_update_version) {
my @updates = sort glob "$self->{update_dir}/*.pl";
return grep { my ($version) = split /_/, basename $_; $version > $last_update_version } @updates;
}
@ -68,16 +64,14 @@ sub get_current_version {
return PBot::VERSION::BUILD_REVISION;
}
sub get_last_update_version {
my ($self) = @_;
sub get_last_update_version($self) {
open(my $fh, '<', "$self->{data_dir}/last_update") or return 0;
chomp(my $last_update = <$fh>);
close $fh;
return $last_update;
}
sub put_last_update_version {
my ($self, $version) = @_;
sub put_last_update_version($self, $version) {
if (open(my $fh, '>', "$self->{data_dir}/last_update")) {
print $fh "$version\n";
close $fh;

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

@ -10,9 +10,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{storage} = PBot::Core::Storage::HashObject->new(
pbot => $conf{pbot},
name => 'Users',
@ -25,12 +23,10 @@ sub initialize {
$self->load;
}
sub add_user {
my ($self, $name, $channels, $hostmasks, $capabilities, $password, $dont_save) = @_;
sub add_user($self, $name, $channels, $hostmasks, $capabilities = 'none', $password = undef, $dont_save = 0) {
$channels = 'global' if $channels !~ m/^#/;
$capabilities //= 'none';
$password //= $self->{pbot}->random_nick(16);
$password //= $self->{pbot}->random_nick(16);
my $data = {
channels => $channels,
@ -49,16 +45,13 @@ sub add_user {
return $data;
}
sub remove_user {
my ($self, $name) = @_;
sub remove_user($self, $name) {
my $result = $self->{storage}->remove($name);
$self->rebuild_user_index;
return $result;
}
sub load {
my $self = shift;
sub load($self) {
$self->{storage}->load;
$self->rebuild_user_index;
@ -75,14 +68,11 @@ sub load {
$self->{pbot}->{logger}->log(" $i users loaded.\n");
}
sub save {
my ($self) = @_;
sub save($self) {
$self->{storage}->save;
}
sub rebuild_user_index {
my ($self) = @_;
sub rebuild_user_index($self) {
$self->{user_index} = {};
$self->{user_cache} = {};
@ -101,25 +91,21 @@ sub rebuild_user_index {
}
}
sub cache_user {
my ($self, $channel, $hostmask, $username, $account_mask) = @_;
sub cache_user($self, $channel, $hostmask, $username, $account_mask) {
return if not length $username or not length $account_mask;
$self->{user_cache}->{lc $channel}->{lc $hostmask} = [ $username, $account_mask ];
}
sub decache_user {
my ($self, $channel, $hostmask) = @_;
sub decache_user($self, $channel, $hostmask) {
my $lc_channel = lc $channel;
my $lc_hostmask = lc $hostmask;
delete $self->{user_cache}->{$lc_channel}->{$lc_hostmask} if exists $self->{user_cache}->{$lc_channel};
delete $self->{user_cache}->{global}->{$lc_hostmask};
}
sub find_user_account {
my ($self, $channel, $hostmask, $any_channel) = @_;
sub find_user_account($self, $channel, $hostmask, $any_channel = 0) {
$channel = lc $channel;
$hostmask = lc $hostmask;
$any_channel //= 0;
# first try to find an exact match
@ -167,9 +153,7 @@ sub find_user_account {
return (undef, $hostmask);
}
sub find_user {
my ($self, $channel, $hostmask, $any_channel) = @_;
$any_channel //= 0;
sub find_user($self, $channel, $hostmask, $any_channel = 0) {
my ($found_channel, $found_hostmask) = $self->find_user_account($channel, $hostmask, $any_channel);
return undef if not defined $found_channel;
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);
}
sub find_admin {
my ($self, $from, $hostmask) = @_;
sub find_admin($self, $from, $hostmask) {
my $user = $self->find_user($from, $hostmask);
return undef if not defined $user;
return undef if not $self->{pbot}->{capabilities}->userhas($user, 'admin');
return $user;
}
sub login {
my ($self, $channel, $hostmask, $password) = @_;
sub login($self, $channel, $hostmask, $password = undef) {
my $user = $self->find_user($channel, $hostmask);
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.";
}
sub logout {
my ($self, $channel, $hostmask) = @_;
sub logout($self, $channel, $hostmask) {
my $user = $self->find_user($channel, $hostmask);
delete $user->{loggedin} if defined $user;
}
sub loggedin {
my ($self, $channel, $hostmask) = @_;
sub loggedin($self, $channel, $hostmask) {
my $user = $self->find_user($channel, $hostmask);
return $user if defined $user and $user->{loggedin};
return undef;
}
sub loggedin_admin {
my ($self, $channel, $hostmask) = @_;
sub loggedin_admin($self, $channel, $hostmask) {
my $user = $self->loggedin($channel, $hostmask);
return $user if defined $user and $self->{pbot}->{capabilities}->userhas($user, 'admin');
return undef;
}
sub get_user_metadata {
my ($self, $channel, $hostmask, $key) = @_;
sub get_user_metadata($self, $channel, $hostmask, $key) {
my $user = $self->find_user($channel, $hostmask, 1);
return $user->{lc $key} if $user;
return undef;
}
sub get_loggedin_user_metadata {
my ($self, $channel, $hostmask, $key) = @_;
sub get_loggedin_user_metadata($self, $channel, $hostmask, $key) {
my $user = $self->loggedin($channel, $hostmask);
return $user->{lc $key} if $user;
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
# specified duration.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Utils::LWPUserAgentCached;
@ -22,17 +22,16 @@ our %default_cache_args = (
'default_expires_in' => 600
);
sub new {
my $class = shift;
sub new($class, @args) {
my $cache_opt;
my %lwp_opt;
unless (scalar @_ % 2) {
%lwp_opt = @_;
unless (scalar @args % 2) {
%lwp_opt = @args;
$cache_opt = {};
for my $key (qw(namespace cache_root default_expires_in)) { $cache_opt->{$key} = delete $lwp_opt{$key} if exists $lwp_opt{$key}; }
} else {
$cache_opt = shift || {};
%lwp_opt = @_;
$cache_opt = shift @args || {};
%lwp_opt = @args;
}
my $self = $class->SUPER::new(%lwp_opt);
my %cache_args = (%default_cache_args, %$cache_opt);
@ -40,8 +39,7 @@ sub new {
return $self;
}
sub request {
my ($self, @args) = @_;
sub request($self, @args) {
my $request = $args[0];
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 @EXPORT = qw/load_modules/;
sub load_modules {
my ($self, $base) = @_;
sub load_modules($self, $base) {
my $base_path = join '/', split '::', $base;
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::Duration;
sub new {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
my ($class, %args) = @_;
sub new($class, %args) {
my $self = bless {}, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
}
# expands stuff like "7d3h" to "7 days and 3 hours"
sub unconcise {
my ($input) = @_;
sub unconcise($input) {
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/ and $//;
@ -38,9 +34,7 @@ sub unconcise {
# parses English natural language date strings into seconds
# does not accept times or dates in the past
sub parsedate {
my ($self, $input) = @_;
sub parsedate($self, $input) {
my $examples = "Try `30s`, `1h30m`, `tomorrow`, `next monday`, `9:30am pdt`, `11pm utc`, etc.";
my $attempts = 0;

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

@ -9,52 +9,40 @@ package PBot::Core::Utils::PriorityQueue;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
return bless {
# list of entries; each entry is expected to have a `priority` and an `id` field
queue => [],
}, $class;
}
sub queue {
my ($self) = @_;
sub queue($self) {
return $self->{queue};
}
sub entries {
my ($self) = @_;
sub entries($self) {
return @{$self->{queue}};
}
sub count {
my ($self) = @_;
sub count($self) {
return scalar @{$self->{queue}};
}
sub get {
my ($self, $position) = @_;
sub get($self, $position) {
return $self->{queue}->[$position];
}
sub get_priority {
my ($self, $position) = @_;
sub get_priority($self, $position) {
return $self->{queue}->[$position]->{priority};
}
sub remove {
my ($self, $position) = @_;
sub remove($self, $position) {
return splice @{$self->{queue}}, $position, 1;
}
# quickly and efficiently find the best position in the entry
# queue array for a given priority value
sub find_enqueue_position {
my ($self, $priority) = @_;
$priority //= 0;
sub find_enqueue_position($self, $priority = 0) {
# shorter alias
my $queue = $self->{queue};
@ -98,15 +86,13 @@ sub find_enqueue_position {
return $lo;
}
sub add {
my ($self, $entry) = @_;
sub add($self, $entry) {
my $position = $self->find_enqueue_position($entry->{priority});
splice @{$self->{queue}}, $position, 0, $entry;
return $position;
}
sub update_priority {
my ($self, $id, $priority) = @_;
sub update_priority($self, $id, $priority) {
my @entries = grep { $_->{id} eq $id } @{$self->{queue}};
map { $_->{priority} = $priority } @entries;
$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);
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
my $self = {
pbot => $args{pbot},
buf => '',
@ -24,9 +22,7 @@ sub new {
return bless $self, $class;
}
sub log {
my $self = shift;
sub log($self) {
$self->{buf} .= shift;
# DBI feeds us pieces at a time, so accumulate a complete line
@ -37,9 +33,7 @@ sub log {
}
}
sub log_message {
my ($self) = @_;
sub log_message($self) {
my $now = gettimeofday;
my $elapsed = $now - $self->{timestamp};
@ -54,9 +48,7 @@ sub log_message {
$self->{timestamp} = $now;
}
sub close {
my ($self) = @_;
sub close($self) {
# log anything left in buf when closing
if ($self->{buf}) {
$self->log_message;

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

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

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

@ -14,8 +14,7 @@ require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/safe_filename/;
sub safe_filename {
my ($name) = @_;
sub safe_filename($name) {
my $safe = '';
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.
sub validate_string {
my ($string, $max_length) = @_;
sub validate_string($string, $max_length = 1024 * 8) {
if (not defined $string or not length $string) {
# nothing to validate; return as-is.
return $string;
}
# set default max length if none given
$max_length //= 1024 * 8;
local $@;
eval {
# attempt to decode as a JSON string
@ -86,9 +81,7 @@ sub validate_string {
# validates the string.
# safely performs Unicode truncation given a byte length, handles
# unwanted characters, etc.
sub validate_this_string {
my ($string, $max_length) = @_;
sub validate_this_string($string, $max_length = 1024 * 8) {
# truncate safely
if ($max_length > 0) {
$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 Encode;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# There used to be many more paste sites in this list but one by one
# many have died off. :-(
@ -29,9 +27,7 @@ sub initialize {
$self->{current_site} = 0;
}
sub get_paste_site {
my ($self) = @_;
sub get_paste_site($self) {
# get the next paste site's subroutine reference
my $subref = $self->{paste_sites}->[$self->{current_site}];
@ -43,9 +39,7 @@ sub get_paste_site {
return $subref;
}
sub paste {
my ($self, $text, %opts) = @_;
sub paste($self, $text, %opts) {
my %default_opts = (
no_split => 0,
);
@ -84,9 +78,7 @@ sub paste {
return $result;
}
sub paste_0x0st {
my ($self, $text) = @_;
sub paste_0x0st($self, $text) {
my $ua = LWP::UserAgent::Paranoid->new(request_timeout => 10);
push @{$ua->requests_redirectable}, 'POST';
@ -98,9 +90,7 @@ sub paste_0x0st {
);
}
sub paste_ixio {
my ($self, $text) = @_;
sub paste_ixio($self, $text) {
my $ua = LWP::UserAgent::Paranoid->new(request_timeout => 10);
push @{$ua->requests_redirectable}, 'POST';

3
lib/PBot/Imports.pm
View File

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

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

@ -96,7 +96,7 @@ sub on_departure($self, $event_type, $event) {
return 0;
}
sub load_questions($self, $filename) {
sub load_questions($self, $filename = undef) {
if (not defined $filename) {
$filename = exists $self->{loaded_filename} ? $self->{loaded_filename} : $self->{questions_filename};
} else {
@ -597,6 +597,7 @@ sub cmd_spinach($self, $context) {
}
when ($_ eq 'lie' or $_ eq 'truth' or $_ eq 'choose') {
$arguments //= '';
$arguments = lc $arguments;
if ($self->{current_state} =~ /choosecategory$/) {
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
use constant {
BUILD_NAME => "PBot",
BUILD_REVISION => 4647,
BUILD_REVISION => 4648,
BUILD_DATE => "2023-04-13",
};