mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-26 22:09:26 +01:00
350 lines
12 KiB
Perl
350 lines
12 KiB
Perl
# File: Commands.pm
|
|
#
|
|
# Author: pragma_
|
|
#
|
|
# Purpose: Registers commands. Invokes commands with user capability
|
|
# validation.
|
|
|
|
# This Source Code Form is subject to the terms of the Mozilla Public
|
|
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
|
|
package PBot::Commands;
|
|
use parent 'PBot::Class', 'PBot::Registerable';
|
|
|
|
use warnings; use strict;
|
|
use feature 'unicode_strings';
|
|
use utf8;
|
|
|
|
use Time::Duration qw/duration/;
|
|
|
|
sub initialize {
|
|
my ($self, %conf) = @_;
|
|
|
|
# PBot::Commands can register subrefs
|
|
$self->PBot::Registerable::initialize(%conf);
|
|
|
|
# command metadata stored as a HashObject
|
|
$self->{metadata} = PBot::HashObject->new(pbot => $self->{pbot}, name => 'Command metadata', filename => $conf{filename});
|
|
$self->{metadata}->load;
|
|
|
|
# register commands to manipulate command metadata and obtain help
|
|
$self->register(sub { $self->cmd_set(@_) }, "cmdset", 1);
|
|
$self->register(sub { $self->cmd_unset(@_) }, "cmdunset", 1);
|
|
$self->register(sub { $self->cmd_help(@_) }, "help", 0);
|
|
}
|
|
|
|
sub cmd_set {
|
|
my ($self, $context) = @_;
|
|
|
|
my ($command, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
|
|
|
|
if (not defined $command) {
|
|
return "Usage: cmdset <command> [key [value]]";
|
|
}
|
|
|
|
return $self->{metadata}->set($command, $key, $value);
|
|
}
|
|
|
|
sub cmd_unset {
|
|
my ($self, $context) = @_;
|
|
|
|
my ($command, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
|
|
|
|
if (not defined $command or not defined $key) {
|
|
return "Usage: cmdunset <command> <key>";
|
|
}
|
|
|
|
return $self->{metadata}->unset($command, $key);
|
|
}
|
|
|
|
sub cmd_help {
|
|
my ($self, $context) = @_;
|
|
|
|
if (not length $context->{arguments}) {
|
|
return "For general help, see <https://github.com/pragma-/pbot/tree/master/doc>. For help about a specific command or factoid, use `help <keyword> [channel]`.";
|
|
}
|
|
|
|
my $keyword = lc $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
|
|
|
|
# check built-in commands first
|
|
if ($self->exists($keyword)) {
|
|
|
|
# check for command metadata
|
|
if ($self->{metadata}->exists($keyword)) {
|
|
my $name = $self->{metadata}->get_key_name($keyword);
|
|
my $requires_cap = $self->{metadata}->get_data($keyword, 'requires_cap');
|
|
my $help = $self->{metadata}->get_data($keyword, 'help');
|
|
|
|
my $result = "/say $name: ";
|
|
|
|
# prefix help text with required capability
|
|
if ($requires_cap) {
|
|
$result .= "[Requires can-$keyword] ";
|
|
}
|
|
|
|
if (not defined $help or not length $help) {
|
|
$result .= "I have no help text for this command yet. To add help text, use the command `cmdset $keyword help <text>`.";
|
|
} else {
|
|
$result .= $help;
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
# no command metadata available
|
|
return "$keyword is a built-in command, but I have no help for it yet.";
|
|
}
|
|
|
|
# then factoids
|
|
my $channel_arg = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
|
|
|
|
if (not defined $channel_arg or not length $channel_arg) {
|
|
# set channel argument to from if no argument was passed
|
|
$channel_arg = $context->{from};
|
|
}
|
|
|
|
if ($channel_arg !~ /^#/) {
|
|
# set channel argument to global if it's not channel-like
|
|
$channel_arg = '.*';
|
|
}
|
|
|
|
# find factoids
|
|
my @factoids = $self->{pbot}->{factoids}->find_factoid($channel_arg, $keyword, exact_trigger => 1);
|
|
|
|
if (not @factoids or not $factoids[0]) {
|
|
# nothing found
|
|
return "I don't know anything about $keyword.";
|
|
}
|
|
|
|
my ($channel, $trigger);
|
|
|
|
if (@factoids > 1) {
|
|
# ask to disambiguate factoids if found in multiple channels
|
|
if (not grep { $_->[0] eq $channel_arg } @factoids) {
|
|
return
|
|
"/say $keyword found in multiple channels: "
|
|
. (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids)
|
|
. "; use `help $keyword <channel>` to disambiguate.";
|
|
} else {
|
|
foreach my $factoid (@factoids) {
|
|
if ($factoid->[0] eq $channel_arg) {
|
|
($channel, $trigger) = ($factoid->[0], $factoid->[1]);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
($channel, $trigger) = ($factoids[0]->[0], $factoids[0]->[1]);
|
|
}
|
|
|
|
# get canonical channel and trigger names with original typographical casing
|
|
my $channel_name = $self->{pbot}->{factoids}->{factoids}->get_key_name($channel);
|
|
my $trigger_name = $self->{pbot}->{factoids}->{factoids}->get_key_name($channel, $trigger);
|
|
|
|
# prettify channel name if it's ".*"
|
|
if ($channel_name eq '.*') {
|
|
$channel_name = 'global channel';
|
|
}
|
|
|
|
# prettify trigger name with double-quotes if it contains spaces
|
|
if ($trigger_name =~ / /) {
|
|
$trigger_name = "\"$trigger_name\"";
|
|
}
|
|
|
|
# get factoid's `help` metadata
|
|
my $help = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, 'help');
|
|
|
|
# return immediately if no help text
|
|
if (not defined $help or not length $help) {
|
|
return "/say $trigger_name is a factoid for $channel_name, but I have no help text for it yet."
|
|
. " To add help text, use the command `factset $trigger_name help <text>`.";
|
|
}
|
|
|
|
my $result = "/say ";
|
|
|
|
# if factoid doesn't belong to invoked or global channel,
|
|
# then prefix with the factoid's channel name.
|
|
if ($channel ne $context->{from} and $channel ne '.*') {
|
|
$result .= "[$channel_name] ";
|
|
}
|
|
|
|
$result .= "$trigger_name: $help";
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub register {
|
|
my ($self, $subref, $name, $requires_cap) = @_;
|
|
|
|
if (not defined $subref or not defined $name) {
|
|
Carp::croak("Missing parameters to Commands::register");
|
|
}
|
|
|
|
# register subref
|
|
my $command = $self->PBot::Registerable::register($subref);
|
|
|
|
# update internal metadata
|
|
$command->{name} = lc $name;
|
|
$command->{requires_cap} = $requires_cap // 0;
|
|
|
|
# update command metadata
|
|
if (not $self->{metadata}->exists($name)) {
|
|
$self->{metadata}->add($name, { requires_cap => $requires_cap, help => '' }, 1);
|
|
} else {
|
|
# metadata already exists, just update requires_cap unless it's already set.
|
|
if (not defined $self->get_meta($name, 'requires_cap')) {
|
|
$self->{metadata}->set($name, 'requires_cap', $requires_cap, 1);
|
|
}
|
|
}
|
|
|
|
# add can-<command> capability to PBot capabilities if required
|
|
if ($requires_cap) {
|
|
$self->{pbot}->{capabilities}->add("can-$name", undef, 1);
|
|
}
|
|
|
|
return $command;
|
|
}
|
|
|
|
sub unregister {
|
|
my ($self, $name) = @_;
|
|
Carp::croak("Missing name parameter to Commands::unregister") if not defined $name;
|
|
$name = lc $name;
|
|
@{$self->{handlers}} = grep { $_->{name} ne $name } @{$self->{handlers}};
|
|
}
|
|
|
|
sub exists {
|
|
my ($self, $keyword) = @_;
|
|
$keyword = lc $keyword;
|
|
foreach my $command (@{$self->{handlers}}) { return 1 if $command->{name} eq $keyword; }
|
|
return 0;
|
|
}
|
|
|
|
sub set_meta {
|
|
my ($self, $command, $key, $value, $save) = @_;
|
|
return undef if not $self->{metadata}->exists($command);
|
|
$self->{metadata}->set($command, $key, $value, !$save);
|
|
return 1;
|
|
}
|
|
|
|
sub get_meta {
|
|
my ($self, $command, $key) = @_;
|
|
return $self->{metadata}->get_data($command, $key);
|
|
}
|
|
|
|
# main entry point for PBot::Interpreter to interpret a registered bot command
|
|
# see also PBot::Factoids::interpreter() for factoid commands
|
|
sub interpreter {
|
|
my ($self, $context) = @_;
|
|
|
|
# debug flag to trace $context location and contents
|
|
if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) {
|
|
use Data::Dumper;
|
|
$Data::Dumper::Sortkeys = 1;
|
|
$self->{pbot}->{logger}->log("Commands::interpreter\n");
|
|
$self->{pbot}->{logger}->log(Dumper $context);
|
|
}
|
|
|
|
# some convenient aliases
|
|
my $keyword = lc $context->{keyword};
|
|
my $from = $context->{from};
|
|
|
|
# set the channel the command is in reference to
|
|
my ($cmd_channel) = $context->{arguments} =~ m/\B(#[^ ]+)/; # assume command is invoked in regards to first channel-like argument
|
|
$cmd_channel = $from if not defined $cmd_channel; # otherwise command is invoked in regards to the channel the user is in
|
|
|
|
$context->{channel} = $cmd_channel;
|
|
|
|
# get the user's bot account
|
|
my $user = $self->{pbot}->{users}->find_user($cmd_channel, $context->{hostmask});
|
|
|
|
# check for a capability override
|
|
my $cap_override;
|
|
|
|
if (exists $context->{'cap-override'}) {
|
|
$self->{pbot}->{logger}->log("Override cap to $context->{'cap-override'}\n");
|
|
$cap_override = $context->{'cap-override'};
|
|
}
|
|
|
|
# go through all commands
|
|
# TODO: maybe use a hash lookup
|
|
foreach my $command (@{$self->{handlers}}) {
|
|
|
|
# is this the command
|
|
if ($command->{name} eq $keyword) {
|
|
|
|
# does this command require capabilities
|
|
my $requires_cap = $self->get_meta($keyword, 'requires_cap') // $command->{requires_cap};
|
|
|
|
if ($requires_cap) {
|
|
if (defined $cap_override) {
|
|
if (not $self->{pbot}->{capabilities}->has($cap_override, "can-$keyword")) {
|
|
return "/msg $context->{nick} The $keyword command requires the can-$keyword capability, which cap-override $cap_override does not have.";
|
|
}
|
|
} else {
|
|
if (not defined $user) {
|
|
my ($found_chan, $found_mask) = $self->{pbot}->{users}->find_user_account($cmd_channel, $context->{hostmask}, 1);
|
|
|
|
if (not defined $found_chan) {
|
|
return "/msg $context->{nick} You must have a user account to use $keyword. You may use the `my` command to create a personal user account. See `help my`.";
|
|
} else {
|
|
return "/msg $context->{nick} You must have a user account in $cmd_channel to use $keyword. (You have an account in $found_chan.)";
|
|
}
|
|
} elsif (not $user->{loggedin}) {
|
|
return "/msg $context->{nick} You must be logged into your user account to use $keyword.";
|
|
}
|
|
|
|
if (not $self->{pbot}->{capabilities}->userhas($user, "can-$keyword")) {
|
|
return "/msg $context->{nick} The $keyword command requires the can-$keyword capability, which your user account does not have.";
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($self->get_meta($keyword, 'preserve_whitespace')) {
|
|
$context->{preserve_whitespace} = 1;
|
|
}
|
|
|
|
unless ($self->get_meta($keyword, 'dont-replace-pronouns')) {
|
|
$context->{arguments} = $self->{pbot}->{factoids}->expand_factoid_vars($context, $context->{arguments});
|
|
$context->{arglist} = $self->{pbot}->{interpreter}->make_args($context->{arguments});
|
|
}
|
|
|
|
$self->{pbot}->{logger}->log("Disabling nickprefix\n");
|
|
$context->{nickprefix_disabled} = 1;
|
|
|
|
if ($self->get_meta($keyword, 'background-process')) {
|
|
# execute this command as a backgrounded process
|
|
|
|
# set timeout to command metadata value
|
|
my $timeout = $self->get_meta($keyword, 'process-timeout');
|
|
|
|
# otherwise set timeout to default value
|
|
$timeout //= $self->{pbot}->{registry}->get_value('processmanager', 'default_timeout');
|
|
|
|
# execute command in background
|
|
$self->{pbot}->{process_manager}->execute_process(
|
|
$context,
|
|
sub { $context->{result} = $command->{subref}->($context) },
|
|
$timeout,
|
|
);
|
|
|
|
# return no output since it will be handled by process manager
|
|
return '';
|
|
} else {
|
|
# execute this command normally
|
|
my $result = $command->{subref}->($context);
|
|
|
|
# disregard undesired command output if command is embedded
|
|
return undef if $context->{referenced} and $result =~ m/(?:usage:|no results)/i;
|
|
|
|
# return command output
|
|
return $result;
|
|
}
|
|
}
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
1;
|