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

Progress on moving commands from Core to Commands

Browse Source
This commit is contained in:
Pragmatic Software 2021-07-23 07:24:30 -07:00
parent 6b785622aa
commit 2229eecca4
35 changed files with 573 additions and 708 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,10 +25,6 @@ sub initialize {
$self->{pbot}->{registry}->add_default('text', 'banlist', 'debug', '0');
$self->{pbot}->{registry}->add_default('text', 'banlist', 'mute_mode_char', 'q');
$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);
$self->{pbot}->{event_dispatcher}->register_handler('irc.endofnames', sub { $self->get_banlist(@_) });
$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(@_) });
@ -61,91 +57,6 @@ sub initialize {
$self->{pbot}->{event_queue}->enqueue(sub { $self->flush_unban_queue }, 30, 'Flush unban queue');
}
sub cmd_banlist {
my ($self, $context) = @_;
if (not length $context->{arguments}) {
return "Usage: banlist <channel>";
}
my $result = "Ban list for $context->{arguments}:\n";
if ($self->{banlist}->exists($context->{arguments})) {
my $count = $self->{banlist}->get_keys($context->{arguments});
$result .= "$count ban" . ($count == 1 ? '' : 's') . ":\n";
foreach my $mask ($self->{banlist}->get_keys($context->{arguments})) {
my $data = $self->{banlist}->get_data($context->{arguments}, $mask);
$result .= " $mask banned ";
if (defined $data->{timestamp}) {
my $date = strftime "%a %b %e %H:%M:%S %Y %Z", localtime $data->{timestamp};
my $ago = concise ago (time - $data->{timestamp});
$result .= "on $date ($ago) ";
}
$result .= "by $data->{owner} " if defined $data->{owner};
$result .= "for $data->{reason} " if defined $data->{reason};
if (defined $data->{timeout} and $data->{timeout} > 0) {
my $duration = concise duration($data->{timeout} - gettimeofday);
$result .= "($duration remaining)";
}
$result .= ";\n";
}
} else {
$result .= "bans: none;\n";
}
if ($self->{quietlist}->exists($context->{arguments})) {
my $count = $self->{quietlist}->get_keys($context->{arguments});
$result .= "$count mute" . ($count == 1 ? '' : 's') . ":\n";
foreach my $mask ($self->{quietlist}->get_keys($context->{arguments})) {
my $data = $self->{quietlist}->get_data($context->{arguments}, $mask);
$result .= " $mask muted ";
if (defined $data->{timestamp}) {
my $date = strftime "%a %b %e %H:%M:%S %Y %Z", localtime $data->{timestamp};
my $ago = concise ago (time - $data->{timestamp});
$result .= "on $date ($ago) ";
}
$result .= "by $data->{owner} " if defined $data->{owner};
$result .= "for $data->{reason} " if defined $data->{reason};
if (defined $data->{timeout} and $data->{timeout} > 0) {
my $duration = concise duration($data->{timeout} - gettimeofday);
$result .= "($duration remaining)";
}
$result .= ";\n";
}
} else {
$result .= "quiets: none\n";
}
$result =~ s/ ;/;/g;
return $result;
}
sub cmd_checkban {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkban <mask> [channel]" if not defined $target;
$channel = $context->{from} if not defined $channel;
return "Please specify a channel." if $channel !~ /^#/;
return $self->checkban($channel, 'b', $target);
}
sub cmd_checkmute {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkmute <mask> [channel]" if not defined $target;
$channel = $context->{from} if not defined $channel;
return "Please specify a channel." if $channel !~ /^#/;
return $self->checkban($channel, $self->{pbot}->{registry}->get_value('banlist', 'mute_mode_char'), $target);
}
sub get_banlist {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{event}->{args}[1];

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

@ -10,6 +10,14 @@ package PBot::Core::Class;
use PBot::Imports;
our $quiet = 0;
sub import {
my ($package, %opts) = @_;
$quiet = $opts{quiet};
}
sub new {
my ($class, %args) = @_;
@ -22,7 +30,7 @@ sub new {
my $self = bless { pbot => $args{pbot} }, $class;
$self->{pbot}->{logger}->log("Initializing $class\n");
$self->{pbot}->{logger}->log("Initializing $class\n") unless $quiet;
$self->initialize(%args);
return $self;

110
lib/PBot/Core/Commands/BanList.pm Normal file
View File

@ -0,0 +1,110 @@
# File: BanList.pm
#
# Purpose: Registers commands related to bans/quiets.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::BanList;
use parent 'PBot::Core::Class';
use PBot::Imports;
use Time::HiRes qw/gettimeofday/;
use Time::Duration;
use POSIX qw/strftime/;
sub initialize {
my ($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);
}
sub cmd_banlist {
my ($self, $context) = @_;
if (not length $context->{arguments}) {
return "Usage: banlist <channel>";
}
my $result = "Ban list for $context->{arguments}:\n";
if ($self->{pbot}->{banlist}->{banlist}->exists($context->{arguments})) {
my $count = $self->{pbot}->{banlist}->{banlist}->get_keys($context->{arguments});
$result .= "$count ban" . ($count == 1 ? '' : 's') . ":\n";
foreach my $mask ($self->{pbot}->{banlist}->{banlist}->get_keys($context->{arguments})) {
my $data = $self->{pbot}->{banlist}->{banlist}->get_data($context->{arguments}, $mask);
$result .= " $mask banned ";
if (defined $data->{timestamp}) {
my $date = strftime "%a %b %e %H:%M:%S %Y %Z", localtime $data->{timestamp};
my $ago = concise ago (time - $data->{timestamp});
$result .= "on $date ($ago) ";
}
$result .= "by $data->{owner} " if defined $data->{owner};
$result .= "for $data->{reason} " if defined $data->{reason};
if (defined $data->{timeout} and $data->{timeout} > 0) {
my $duration = concise duration($data->{timeout} - gettimeofday);
$result .= "($duration remaining)";
}
$result .= ";\n";
}
} else {
$result .= "bans: none;\n";
}
if ($self->{pbot}->{banlist}->{quietlist}->exists($context->{arguments})) {
my $count = $self->{pbot}->{banlist}->{quietlist}->get_keys($context->{arguments});
$result .= "$count mute" . ($count == 1 ? '' : 's') . ":\n";
foreach my $mask ($self->{pbot}->{banlist}->{quietlist}->get_keys($context->{arguments})) {
my $data = $self->{pbot}->{banlist}->{quietlist}->get_data($context->{arguments}, $mask);
$result .= " $mask muted ";
if (defined $data->{timestamp}) {
my $date = strftime "%a %b %e %H:%M:%S %Y %Z", localtime $data->{timestamp};
my $ago = concise ago (time - $data->{timestamp});
$result .= "on $date ($ago) ";
}
$result .= "by $data->{owner} " if defined $data->{owner};
$result .= "for $data->{reason} " if defined $data->{reason};
if (defined $data->{timeout} and $data->{timeout} > 0) {
my $duration = concise duration($data->{timeout} - gettimeofday);
$result .= "($duration remaining)";
}
$result .= ";\n";
}
} else {
$result .= "quiets: none\n";
}
$result =~ s/ ;/;/g;
return $result;
}
sub cmd_checkban {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkban <mask> [channel]" if not defined $target;
$channel = $context->{from} if not defined $channel;
return "Please specify a channel." if $channel !~ /^#/;
return $self->{pbot}->{banlist}->checkban($channel, 'b', $target);
}
sub cmd_checkmute {
my ($self, $context) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: checkmute <mask> [channel]" if not defined $target;
$channel = $context->{from} if not defined $channel;
return "Please specify a channel." if $channel !~ /^#/;
return $self->{pbot}->{banlist}->checkban($channel, $self->{pbot}->{registry}->get_value('banlist', 'mute_mode_char'), $target);
}
1;

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

@ -8,19 +8,7 @@
package PBot::Core::Commands::Capabilities;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

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

@ -8,23 +8,11 @@
package PBot::Core::Commands::ChanOp;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::Duration;
use Time::HiRes qw/gettimeofday/;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
@ -628,23 +616,18 @@ sub cmd_unmute {
sub cmd_kick {
my ($self, $context) = @_;
if (not defined $context->{from}) {
$self->{pbot}->{logger}->log("Command missing ~from parameter!\n");
return "";
}
my ($channel, $victim, $reason);
my $arguments = $context->{arguments};
if (not $context->{from} =~ /^#/) {
# used in private message
if (not $arguments =~ s/^(^#\S+) (\S+)\s*//) { return "Usage from private message: kick <channel> <nick> [reason]"; }
if (not $arguments =~ s/^(^#\S+) (\S+)\s*//) { return "Usage from private message: kick <channel> <nick[,nicks...]> [reason]; <nick> may include wildcards"; }
($channel, $victim) = ($1, $2);
} else {
# used in channel
if ($arguments =~ s/^(#\S+)\s+(\S+)\s*//) { ($channel, $victim) = ($1, $2); }
elsif ($arguments =~ s/^(\S+)\s*//) { ($victim, $channel) = ($1, exists $context->{admin_channel_override} ? $context->{admin_channel_override} : $context->{from}); }
else { return "Usage: kick [channel] <nick> [reason]"; }
else { return "Usage: kick [channel] <nick[,nicks...]> [reason]; <nick> may include wildcards"; }
}
$reason = $arguments;

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

@ -8,19 +8,7 @@
package PBot::Core::Commands::Channels;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

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

@ -8,19 +8,7 @@
package PBot::Core::Commands::CommandMetadata;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

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

@ -8,22 +8,10 @@
package PBot::Core::Commands::EventQueue;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::Duration;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

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

@ -8,6 +8,7 @@
package PBot::Core::Commands::Factoids;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::Duration;
use Time::HiRes qw(gettimeofday);
@ -40,19 +41,6 @@ our %factoid_metadata_capabilities = (
# all others are allowed to be factset by anybody
);
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

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

@ -8,19 +8,7 @@
package PBot::Core::Commands::Help;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

58
lib/PBot/Core/Commands/LagChecker.pm Normal file
View File

@ -0,0 +1,58 @@
# File: LagChecker.pm
#
# Purpose: Registers command to query lag history.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::LagChecker;
use parent 'PBot::Core::Class';
use PBot::Imports;
use Time::Duration qw/concise ago/;
use Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_lagcheck(@_) }, "lagcheck", 0);
}
sub cmd_lagcheck {
my ($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});
my $lag_total = $elapsed;
my $len = @{$self->{pbot}->{lagchecker}->{lag_history}};
my @entries;
foreach my $entry (@{$self->{pbot}->{lagchecker}->{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;
}
push @entries, "[waiting for pong] $elapsed";
my $lagstring = join '; ', @entries;
my $average = $lag_total / ($len + 1);
$lagstring .= "; average: " . sprintf "%.1f ms", $average;
return $lagstring;
}
return "My lag: " . $self->{pbot}->{lagchecker}->lagstring;
}
1;

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

@ -8,24 +8,12 @@
package PBot::Core::Commands::MessageHistory;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Getopt::Long qw(GetOptionsFromArray);
use Time::HiRes qw(time tv_interval);
use Time::Duration;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

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

@ -9,22 +9,10 @@
package PBot::Core::Commands::Misc;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::Duration qw/duration/;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

73
lib/PBot/Core/Commands/Modules.pm Normal file
View File

@ -0,0 +1,73 @@
# File: Modules.pm
#
# Purpose: Registers commands to load and unload PBot modules.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::Modules;
use parent 'PBot::Core::Class';
use PBot::Imports;
use IPC::Run qw/run timeout/;
use Encode;
sub initialize {
my ($self, %conf) = @_;
# bot commands to load and unload modules
$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) = @_;
my ($keyword, $module) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: load <keyword> <module>" if not defined $module;
my $factoids = $self->{pbot}->{factoids}->{storage};
if ($factoids->exists('.*', $keyword)) {
return 'There is already a keyword named ' . $factoids->get_data('.*', $keyword, '_name') . '.';
}
$self->{pbot}->{factoids}->add_factoid('module', '.*', $context->{hostmask}, $keyword, $module, 1);
$factoids->set('.*', $keyword, 'add_nick', 1, 1);
$factoids->set('.*', $keyword, 'nooverride', 1);
$self->{pbot}->{logger}->log("$context->{hostmask} loaded module $keyword => $module\n");
return "Loaded module $keyword => $module";
}
sub cmd_unload {
my ($self, $context) = @_;
my $module = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
return "Usage: unload <keyword>" if not defined $module;
my $factoids = $self->{pbot}->{factoids}->{storage};
if (not $factoids->exists('.*', $module)) {
return "/say $module not found.";
}
if ($factoids->get_data('.*', $module, 'type') ne 'module') {
return "/say " . $factoids->get_data('.*', $module, '_name') . ' is not a module.';
}
my $name = $factoids->get_data('.*', $module, '_name');
$factoids->remove('.*', $module);
$self->{pbot}->{logger}->log("$context->{hostmask} unloaded module $module\n");
return "/say $name unloaded.";
}
1;

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

@ -8,25 +8,13 @@
package PBot::Core::Commands::NickList;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/concise ago/;
use Getopt::Long qw/GetOptionsFromArray/;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_nicklist(@_) }, "nicklist", 1);

79
lib/PBot/Core/Commands/Plugins.pm Normal file
View File

@ -0,0 +1,79 @@
# File: Plugins.pm
#
# Purpose: Registers commands for loading and unloading plugins.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::Plugins;
use PBot::Imports;
use parent 'PBot::Core::Class';
use File::Basename;
sub initialize {
my ($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);
$self->{pbot}->{commands}->register(sub { $self->cmd_replug(@_) }, "replug", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_pluglist(@_) }, "pluglist", 0);
}
sub cmd_plug {
my ($self, $context) = @_;
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: plug <plugin>"; }
if ($self->{pbot}->{plugins}->load($plugin)) {
return "Loaded $plugin plugin.";
} else {
return "Plugin $plugin failed to load.";
}
}
sub cmd_unplug {
my ($self, $context) = @_;
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: unplug <plugin>"; }
if ($self->{pbot}->{plugins}->unload($plugin)) {
return "Unloaded $plugin plugin.";
} else {
return "Plugin $plugin is not loaded.";
}
}
sub cmd_replug {
my ($self, $context) = @_;
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: replug <plugin>"; }
my $unload_result = $self->cmd_unplug($context);
my $load_result = $self->cmd_plug($context);
my $result;
$result .= "$unload_result " if $unload_result =~ m/^Unloaded/;
$result .= $load_result;
return $result;
}
sub cmd_pluglist {
my ($self, $context) = @_;
my @plugins = sort keys %{$self->{pbot}->{plugins}->{plugins}};
return "No plugins loaded." if not @plugins;
return scalar @plugins . ' plugin' . (@plugins == 1 ? '' : 's') . ' loaded: ' . join (', ', @plugins);
}
1;

154
lib/PBot/Core/Commands/ProcessManager.pm Normal file
View File

@ -0,0 +1,154 @@
# File: ProcessManager.pm
#
# Purpose: Registers commands for listing and killing running PBot processes.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::ProcessManager;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::Duration qw/concise duration/;
use Time::HiRes qw/gettimeofday/;
use Getopt::Long qw/GetOptionsFromArray/;
sub initialize {
my ($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);
# give admin capability group the can-kill capability
$self->{pbot}->{capabilities}->add('admin', 'can-kill', 1);
}
sub cmd_ps {
my ($self, $context) = @_;
my $usage = 'Usage: ps [-atu]; -a show all information; -t show running time; -u show user/channel';
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling");
my ($show_all, $show_user, $show_running_time);
my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'all|a' => \$show_all,
'user|u' => \$show_user,
'time|t' => \$show_running_time
);
return "$getopt_error; $usage" if defined $getopt_error;
my @processes;
foreach my $pid (sort keys %{$self->{pbot}->{process_manager}->{processes}}) {
push @processes, $self->{pbot}->{process_manager}->{processes}->{$pid};
}
if (not @processes) {
return "No running processes.";
}
my $result = @processes == 1 ? 'One process: ' : @processes . ' processes: ';
my @entries;
foreach my $process (@processes) {
my $entry = "$process->{pid}: $process->{commands}->[0]";
if ($show_running_time or $show_all) {
my $duration = concise duration (gettimeofday - $process->{process_start});
$entry .= " [$duration]";
}
if ($show_user or $show_all) {
$entry .= " ($process->{nick} in $process->{from})";
}
push @entries, $entry;
}
$result .= join '; ', @entries;
return $result;
}
sub cmd_kill {
my ($self, $context) = @_;
my $usage = 'Usage: kill [-a] [-t <seconds>] [-s <signal>] [pids...]; -a kill all processes; -t <seconds> kill processes running longer than <seconds>; -s send <signal> to processes';
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling");
my ($kill_all, $kill_time, $signal);
my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, preserve_escapes => 1, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'all|a' => \$kill_all,
'time|t=i' => \$kill_time,
'signal|s=s' => \$signal,
);
return "$getopt_error; $usage" if defined $getopt_error;
if (not $kill_all and not $kill_time and not @opt_args) {
return "Must specify PIDs to kill unless options -a or -t are provided.";
}
if (defined $signal) {
$signal = uc $signal;
} else {
$signal = 'INT';
}
my @pids;
if (defined $kill_all or defined $kill_time) {
my $now = time;
foreach my $pid (sort keys %{$self->{pbot}->{process_manager}->{processes}}) {
my $process = $self->{pbot}->{process_manager}->{processes}->{$pid};
next if defined $kill_time and $now - $process->{process_start} < $kill_time;
push @pids, $pid;
}
} else {
foreach my $pid (@opt_args) {
return "No such pid $pid." if not exists $self->{pbot}->{process_manager}->{processes}->{$pid};
push @pids, $pid;
}
}
return "No matching process." if not @pids;
my $ret = eval { kill $signal, @pids };
if ($@) {
my $error = $@;
$error =~ s/ at PBot.*//;
return $error;
}
return "[$ret] Sent signal " . $signal . ' to ' . join ', ', @pids;
}
1;

65
lib/PBot/Core/Commands/Refresher.pm Normal file
View File

@ -0,0 +1,65 @@
# File: Refresher.pm
#
# Purpose: Registers command to refresh PBot's Perl modules.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::Refresher;
use PBot::Imports;
use parent 'PBot::Core::Class';
use File::Basename;
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_refresh(@_) }, "refresh", 1);
}
sub cmd_refresh {
my ($self, $context) = @_;
my $last_update = $self->{pbot}->{updater}->get_last_update_version;
my @updates = $self->{pbot}->{updater}->get_available_updates($last_update);
if (@updates) {
return "Update available; cannot refresh. Please restart PBot to begin update of " . join(', ', map { basename $_ } @updates);
}
my $refresh_error;
local $SIG{__WARN__} = sub {
my $warning = shift;
warn $warning and return if $warning =~ /Can't undef active/;
warn $warning and return if $warning =~ /subroutine .* redefined/i;
$refresh_error = $warning;
$refresh_error =~ s/\s+Compilation failed in require at \/usr.*//;
$refresh_error =~ s/in \@INC.*/in \@INC/;
$self->{pbot}->{logger}->log("Error refreshing: $refresh_error\n");
};
my $result = eval {
if (not $context->{arguments}) {
$self->{pbot}->{logger}->log("Refreshing all modified modules\n");
$self->{pbot}->{refresher}->{refresher}->refresh;
return "Error refreshing: $refresh_error" if defined $refresh_error;
return "Refreshed all modified modules.\n";
} else {
$self->{pbot}->{logger}->log("Refreshing module $context->{arguments}\n");
$self->{pbot}->{refresher}->{refresher}->refresh_module($context->{arguments});
return "Error refreshing: $refresh_error" if defined $refresh_error;
$self->{pbot}->{logger}->log("Refreshed module.\n");
return "Refreshed module.\n";
}
};
if ($@) {
$self->{pbot}->{logger}->log("Error refreshing: $@\n");
return $@;
}
return $result;
}
1;

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

@ -8,19 +8,7 @@
package PBot::Core::Commands::Registry;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

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

@ -8,19 +8,7 @@
package PBot::Core::Commands::Users;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

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

@ -15,19 +15,6 @@ use PBot::VERSION qw/BUILD_REVISION BUILD_DATE/;
use LWP::UserAgent;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/Cap.pm
View File

@ -8,19 +8,7 @@
package PBot::Core::IRCHandlers::Cap;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/Channel.pm
View File

@ -9,6 +9,7 @@ package PBot::Core::IRCHandlers::Channel;
use parent 'PBot::Core::Class';
use PBot::Imports;
use parent 'PBot::Core::Class';
use PBot::Core::MessageHistory::Constants ':all';
@ -18,19 +19,6 @@ use Data::Dumper;
use MIME::Base64;
use Encode;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/Chat.pm
View File

@ -8,19 +8,7 @@
package PBot::Core::IRCHandlers::Chat;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/NickList.pm
View File

@ -8,22 +8,10 @@
package PBot::Core::IRCHandlers::NickList;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Time::HiRes qw/gettimeofday/;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/NickServ.pm
View File

@ -8,19 +8,7 @@
package PBot::Core::IRCHandlers::NickServ;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/SASL.pm
View File

@ -8,23 +8,11 @@
package PBot::Core::IRCHandlers::SASL;
use PBot::Imports;
use parent 'PBot::Core::Class';
use Encode;
use MIME::Base64;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/Server.pm
View File

@ -8,24 +8,12 @@
package PBot::Core::IRCHandlers::Server;
use PBot::Imports;
use parent 'PBot::Core::Class';
use PBot::Core::MessageHistory::Constants ':all';
use Time::HiRes qw/time/;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
sub initialize {
my ($self, %conf) = @_;

14
lib/PBot/Core/IRCHandlers/Users.pm
View File

@ -8,19 +8,7 @@
package PBot::Core::IRCHandlers::Users;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
# ensure class was passed a PBot instance
if (not exists $args{pbot}) {
Carp::croak("Missing pbot reference to $class");
}
my $self = bless { pbot => $args{pbot} }, $class;
$self->initialize(%args);
return $self;
}
use parent 'PBot::Core::Class';
sub initialize {
my ($self, %conf) = @_;

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

@ -51,9 +51,6 @@ sub initialize {
'lag check'
);
# lagcheck bot command
$self->{pbot}->{commands}->register(sub { $self->cmd_lagcheck(@_) }, "lagcheck", 0);
# PONG IRC handler
$self->{pbot}->{event_dispatcher}->register_handler('irc.pong', sub { $self->on_pong(@_) });
}
@ -64,43 +61,6 @@ sub trigger_lag_history_interval {
$self->{pbot}->{event_queue}->update_interval('lag check', $newvalue);
}
# lagcheck bot command
sub cmd_lagcheck {
my ($self, $context) = @_;
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});
my $lag_total = $elapsed;
my $len = @{$self->{lag_history}};
my @entries;
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;
}
push @entries, "[waiting for pong] $elapsed";
my $lagstring = join '; ', @entries;
my $average = $lag_total / ($len + 1);
$lagstring .= "; average: " . sprintf "%.1f ms", $average;
return $lagstring;
}
return "My lag: " . $self->lagstring;
}
sub send_ping {
my $self = shift;

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

@ -18,60 +18,7 @@ use IPC::Run qw/run timeout/;
use Encode;
sub initialize {
my ($self, %conf) = @_;
# bot commands to load and unload modules
$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) = @_;
my ($keyword, $module) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: load <keyword> <module>" if not defined $module;
my $factoids = $self->{pbot}->{factoids}->{storage};
if ($factoids->exists('.*', $keyword)) {
return 'There is already a keyword named ' . $factoids->get_data('.*', $keyword, '_name') . '.';
}
$self->{pbot}->{factoids}->add_factoid('module', '.*', $context->{hostmask}, $keyword, $module, 1);
$factoids->set('.*', $keyword, 'add_nick', 1, 1);
$factoids->set('.*', $keyword, 'nooverride', 1);
$self->{pbot}->{logger}->log("$context->{hostmask} loaded module $keyword => $module\n");
return "Loaded module $keyword => $module";
}
sub cmd_unload {
my ($self, $context) = @_;
my $module = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
return "Usage: unload <keyword>" if not defined $module;
my $factoids = $self->{pbot}->{factoids}->{storage};
if (not $factoids->exists('.*', $module)) {
return "/say $module not found.";
}
if ($factoids->get_data('.*', $module, 'type') ne 'module') {
return "/say " . $factoids->get_data('.*', $module, '_name') . ' is not a module.';
}
my $name = $factoids->get_data('.*', $module, '_name');
$factoids->remove('.*', $module);
$self->{pbot}->{logger}->log("$context->{hostmask} unloaded module $module\n");
return "/say $name unloaded.";
# nothing to do here
}
sub execute_module {

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

@ -18,70 +18,10 @@ sub initialize {
# loaded plugins
$self->{plugins} = {};
# plugin management bot commands
$self->{pbot}->{commands}->register(sub { $self->cmd_plug(@_) }, "plug", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unplug(@_) }, "unplug", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_replug(@_) }, "replug", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_pluglist(@_) }, "pluglist", 0);
# autoload plugins listed in `$data_dir/plugins_autoload` file
$self->autoload(%conf);
}
sub cmd_plug {
my ($self, $context) = @_;
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: plug <plugin>"; }
if ($self->load($plugin)) {
return "Loaded $plugin plugin.";
} else {
return "Plugin $plugin failed to load.";
}
}
sub cmd_unplug {
my ($self, $context) = @_;
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: unplug <plugin>"; }
if ($self->unload($plugin)) {
return "Unloaded $plugin plugin.";
} else {
return "Plugin $plugin is not loaded.";
}
}
sub cmd_replug {
my ($self, $context) = @_;
my $plugin = $context->{arguments};
if (not length $plugin) { return "Usage: replug <plugin>"; }
my $unload_result = $self->cmd_unplug($context);
my $load_result = $self->cmd_plug($context);
my $result;
$result .= "$unload_result " if $unload_result =~ m/^Unloaded/;
$result .= $load_result;
return $result;
}
sub cmd_pluglist {
my ($self, $context) = @_;
my @plugins = sort keys %{$self->{plugins}};
return "No plugins loaded." if not @plugins;
return scalar @plugins . ' plugin' . (@plugins == 1 ? '' : 's') . ' loaded: ' . join (', ', @plugins);
}
sub autoload {
my ($self, %conf) = @_;

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

@ -11,22 +11,13 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
use Time::Duration qw/concise duration/;
use Time::HiRes qw/gettimeofday/;
use Getopt::Long qw/GetOptionsFromArray/;
use POSIX qw/WNOHANG/;
use JSON;
sub initialize {
my ($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);
# give admin capability group the can-kill capability
$self->{pbot}->{capabilities}->add('admin', 'can-kill', 1);
# hash of currently running bot-invoked processes
$self->{processes} = {};
@ -36,132 +27,6 @@ sub initialize {
};
}
sub cmd_ps {
my ($self, $context) = @_;
my $usage = 'Usage: ps [-atu]; -a show all information; -t show running time; -u show user/channel';
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling");
my ($show_all, $show_user, $show_running_time);
my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'all|a' => \$show_all,
'user|u' => \$show_user,
'time|t' => \$show_running_time
);
return "$getopt_error; $usage" if defined $getopt_error;
my @processes;
foreach my $pid (sort keys %{$self->{processes}}) {
push @processes, $self->{processes}->{$pid};
}
if (not @processes) {
return "No running processes.";
}
my $result = @processes == 1 ? 'One process: ' : @processes . ' processes: ';
my @entries;
foreach my $process (@processes) {
my $entry = "$process->{pid}: $process->{commands}->[0]";
if ($show_running_time or $show_all) {
my $duration = concise duration (gettimeofday - $process->{process_start});
$entry .= " [$duration]";
}
if ($show_user or $show_all) {
$entry .= " ($process->{nick} in $process->{from})";
}
push @entries, $entry;
}
$result .= join '; ', @entries;
return $result;
}
sub cmd_kill {
my ($self, $context) = @_;
my $usage = 'Usage: kill [-a] [-t <seconds>] [-s <signal>] [pids...]; -a kill all processes; -t <seconds> kill processes running longer than <seconds>; -s send <signal> to processes';
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling");
my ($kill_all, $kill_time, $signal);
my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, preserve_escapes => 1, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'all|a' => \$kill_all,
'time|t=i' => \$kill_time,
'signal|s=s' => \$signal,
);
return "$getopt_error; $usage" if defined $getopt_error;
if (not $kill_all and not $kill_time and not @opt_args) {
return "Must specify PIDs to kill unless options -a or -t are provided.";
}
if (defined $signal) {
$signal = uc $signal;
} else {
$signal = 'INT';
}
my @pids;
if (defined $kill_all or defined $kill_time) {
my $now = time;
foreach my $pid (sort keys %{$self->{processes}}) {
my $process = $self->{processes}->{$pid};
next if defined $kill_time and $now - $process->{process_start} < $kill_time;
push @pids, $pid;
}
} else {
foreach my $pid (@opt_args) {
return "No such pid $pid." if not exists $self->{processes}->{$pid};
push @pids, $pid;
}
}
return "No matching process." if not @pids;
my $ret = eval { kill $signal, @pids };
if ($@) {
my $error = $@;
$error =~ s/ at PBot.*//;
return $error;
}
return "[$ret] Sent signal " . $signal . ' to ' . join ', ', @pids;
}
sub add_process {
my ($self, $pid, $context) = @_;

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

@ -13,58 +13,11 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
use Module::Refresh;
use File::Basename;
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->cmd_refresh(@_) }, "refresh", 1);
$self->{refresher} = Module::Refresh->new;
}
sub cmd_refresh {
my ($self, $context) = @_;
my $last_update = $self->{pbot}->{updater}->get_last_update_version;
my @updates = $self->{pbot}->{updater}->get_available_updates($last_update);
if (@updates) {
return "Update available; cannot refresh. Please restart PBot to begin update of " . join(', ', map { basename $_ } @updates);
}
my $refresh_error;
local $SIG{__WARN__} = sub {
my $warning = shift;
warn $warning and return if $warning =~ /Can't undef active/;
warn $warning and return if $warning =~ /subroutine .* redefined/i;
$refresh_error = $warning;
$refresh_error =~ s/\s+Compilation failed in require at \/usr.*//;
$refresh_error =~ s/in \@INC.*/in \@INC/;
$self->{pbot}->{logger}->log("Error refreshing: $refresh_error\n");
};
my $result = eval {
if (not $context->{arguments}) {
$self->{pbot}->{logger}->log("Refreshing all modified modules\n");
$self->{refresher}->refresh;
return "Error refreshing: $refresh_error" if defined $refresh_error;
return "Refreshed all modified modules.\n";
} else {
$self->{pbot}->{logger}->log("Refreshing module $context->{arguments}\n");
$self->{refresher}->refresh_module($context->{arguments});
return "Error refreshing: $refresh_error" if defined $refresh_error;
$self->{pbot}->{logger}->log("Refreshed module.\n");
return "Refreshed module.\n";
}
};
if ($@) {
$self->{pbot}->{logger}->log("Error refreshing: $@\n");
return $@;
}
return $result;
}
1;

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

@ -34,9 +34,9 @@ sub load_modules {
$self->{pbot}->{logger}->log(" $name\n");
eval {
require "$module";
my $class = $base . '::' . $name;
require "$module";
$class->import(quiet => 1);
$self->{modules}->{$name} = $class->new(pbot => $self->{pbot});
$self->{pbot}->{refresher}->{refresher}->update_cache($module);
};