mirror of
https://github.com/pragma-/pbot.git
synced 2024-10-04 18:38:47 +02:00
Progress on moving commands from Core to Commands
This commit is contained in:
Pragmatic Software
parent
6b785622aa
commit
2229eecca4
@ -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,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
110
lib/PBot/Core/Commands/BanList.pm
Normal 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;
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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
58
lib/PBot/Core/Commands/LagChecker.pm
Normal 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;
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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
73
lib/PBot/Core/Commands/Modules.pm
Normal 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;
|
||||
@ -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
79
lib/PBot/Core/Commands/Plugins.pm
Normal 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
154
lib/PBot/Core/Commands/ProcessManager.pm
Normal 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
65
lib/PBot/Core/Commands/Refresher.pm
Normal 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;
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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 {
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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) = @_;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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);
|
||||
};
|
||||
|
||||
Loading…
Reference in New Issue
Block a user