2010-03-22 08:33:44 +01:00
# File: Commands.pm
2020-02-02 07:17:20 +01:00
#
2010-03-22 08:33:44 +01:00
# Author: pragma_
#
2020-02-03 18:50:38 +01:00
# Purpose: Registers commands. Invokes commands with user capability
# validation.
2010-03-22 08:33:44 +01:00
2017-03-05 22:33:31 +01:00
# 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/.
2010-03-22 08:33:44 +01:00
package PBot::Commands ;
2020-02-08 20:04:13 +01:00
use parent 'PBot::Class' , 'PBot::Registerable' ;
2010-03-22 08:33:44 +01:00
2020-02-08 20:04:13 +01:00
use warnings ; use strict ;
2019-07-11 03:40:53 +02:00
use feature 'unicode_strings' ;
2020-01-24 06:09:57 +01:00
use Time::Duration qw/duration/ ;
2010-03-22 08:33:44 +01:00
sub initialize {
my ( $ self , % conf ) = @ _ ;
2020-02-08 20:04:13 +01:00
$ self - > PBot::Registerable:: initialize ( % conf ) ;
2010-03-22 08:33:44 +01:00
2020-01-19 06:58:58 +01:00
$ self - > { metadata } = PBot::HashObject - > new ( pbot = > $ self - > { pbot } , name = > 'Commands' , filename = > $ conf { filename } ) ;
2020-02-12 06:49:43 +01:00
$ self - > { metadata } - > load ;
2010-03-22 08:33:44 +01:00
2020-02-03 18:50:38 +01:00
$ self - > register ( sub { $ self - > cmdset ( @ _ ) } , "cmdset" , 1 ) ;
$ self - > register ( sub { $ self - > cmdunset ( @ _ ) } , "cmdunset" , 1 ) ;
2020-01-25 21:28:05 +01:00
$ self - > register ( sub { $ self - > help ( @ _ ) } , "help" , 0 ) ;
$ self - > register ( sub { $ self - > uptime ( @ _ ) } , "uptime" , 0 ) ;
2020-02-03 18:50:38 +01:00
$ self - > register ( sub { $ self - > in_channel ( @ _ ) } , "in" , 1 ) ;
2020-02-06 02:55:31 +01:00
2020-02-06 03:30:34 +01:00
$ self - > { pbot } - > { capabilities } - > add ( 'admin' , 'can-in' , 1 ) ;
2010-03-22 08:33:44 +01:00
}
sub register {
2020-02-03 18:50:38 +01:00
my ( $ self , $ subref , $ name , $ requires_cap ) = @ _ ;
2020-02-08 20:04:13 +01:00
Carp:: croak ( "Missing parameters to Commands::register" ) if not defined $ subref or not defined $ name ;
2010-03-22 08:33:44 +01:00
2020-02-08 20:04:13 +01:00
my $ ref = $ self - > PBot::Registerable:: register ( $ subref ) ;
2020-01-19 06:49:55 +01:00
$ ref - > { name } = lc $ name ;
2020-02-03 18:50:38 +01:00
$ ref - > { requires_cap } = $ requires_cap // 0 ;
2010-03-22 08:33:44 +01:00
2020-01-19 06:49:55 +01:00
if ( not $ self - > { metadata } - > exists ( $ name ) ) {
2020-02-03 18:50:38 +01:00
$ self - > { metadata } - > add ( $ name , { requires_cap = > $ requires_cap , help = > '' } , 1 ) ;
2020-01-19 07:13:08 +01:00
} else {
2020-02-03 18:50:38 +01:00
if ( not defined $ self - > get_meta ( $ name , 'requires_cap' ) ) {
$ self - > { metadata } - > set ( $ name , 'requires_cap' , $ requires_cap , 1 ) ;
2020-01-19 07:13:08 +01:00
}
2020-01-19 06:49:55 +01:00
}
2020-02-03 18:50:38 +01:00
# add can-cmd capability
2020-02-04 08:55:24 +01:00
$ self - > { pbot } - > { capabilities } - > add ( "can-$name" , undef , 1 ) if $ requires_cap ;
2010-03-22 08:33:44 +01:00
return $ ref ;
}
2016-02-14 03:38:43 +01:00
sub unregister {
2010-03-22 08:33:44 +01:00
my ( $ self , $ name ) = @ _ ;
2020-01-19 06:49:55 +01:00
Carp:: croak ( "Missing name parameter to Commands::unregister" ) if not defined $ name ;
2010-03-22 08:33:44 +01:00
$ name = lc $ name ;
@ { $ self - > { handlers } } = grep { $ _ - > { name } ne $ name } @ { $ self - > { handlers } } ;
}
2015-04-04 00:33:19 +02:00
sub exists {
2020-01-19 06:49:55 +01:00
my ( $ self , $ keyword ) = @ _ ;
2017-12-03 00:05:30 +01:00
$ keyword = lc $ keyword ;
2015-04-04 00:33:19 +02:00
foreach my $ ref ( @ { $ self - > { handlers } } ) {
2017-12-03 00:05:30 +01:00
return 1 if $ ref - > { name } eq $ keyword ;
2015-04-04 00:33:19 +02:00
}
return 0 ;
}
2010-03-22 08:33:44 +01:00
sub interpreter {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff ) = @ _ ;
2010-03-22 08:33:44 +01:00
my $ result ;
2017-11-21 01:10:48 +01:00
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 $ stuff ) ;
}
2010-03-22 08:33:44 +01:00
2017-11-16 18:23:58 +01:00
my $ keyword = lc $ stuff - > { keyword } ;
2020-02-03 18:50:38 +01:00
my $ from = $ stuff - > { from } ;
my ( $ cmd_channel ) = $ stuff - > { 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
2020-02-10 23:42:29 +01:00
my $ user = $ self - > { pbot } - > { users } - > find_user ( $ cmd_channel , "$stuff->{nick}!$stuff->{user}\@$stuff->{host}" ) ;
2017-08-03 22:30:18 +02:00
2020-02-03 18:50:38 +01:00
my $ cap_override ;
if ( exists $ stuff - > { 'cap-override' } ) {
$ self - > { pbot } - > { logger } - > log ( "Override cap to $stuff->{'cap-override'}\n" ) ;
$ cap_override = $ stuff - > { 'cap-override' } ;
2017-12-11 21:44:19 +01:00
}
2010-03-22 08:33:44 +01:00
foreach my $ ref ( @ { $ self - > { handlers } } ) {
2017-11-16 18:23:58 +01:00
if ( $ ref - > { name } eq $ keyword ) {
2020-02-03 18:50:38 +01:00
my $ requires_cap = $ self - > get_meta ( $ keyword , 'requires_cap' ) // $ ref - > { requires_cap } ;
if ( $ requires_cap ) {
if ( defined $ cap_override ) {
if ( not $ self - > { pbot } - > { capabilities } - > has ( $ cap_override , "can-$keyword" ) ) {
return "/msg $stuff->{nick} The $keyword command requires the can-$keyword capability, which cap-override $cap_override does not have." ;
}
2010-03-22 08:33:44 +01:00
} else {
2020-02-03 18:50:38 +01:00
if ( not defined $ user ) {
2020-02-10 23:42:29 +01:00
my ( $ found_chan , $ found_mask ) = $ self - > { pbot } - > { users } - > find_user_account ( $ cmd_channel , "$stuff->{nick}!$stuff->{user}\@$stuff->{host}" , 1 ) ;
if ( not defined $ found_chan ) {
return "/msg $stuff->{nick} You must have a user account to use $keyword." ;
} else {
return "/msg $stuff->{nick} You must have a user account in $cmd_channel to use $keyword. (You have an account in $found_chan.)" ;
}
} elsif ( not $ user - > { loggedin } ) {
2020-02-03 18:50:38 +01:00
return "/msg $stuff->{nick} You must be logged into your user account to use $keyword." ;
}
if ( not $ self - > { pbot } - > { capabilities } - > userhas ( $ user , "can-$keyword" ) ) {
return "/msg $stuff->{nick} The $keyword command requires the can-$keyword capability, which your user account does not have." ;
}
2010-03-22 08:33:44 +01:00
}
}
2020-02-03 18:50:38 +01:00
$ stuff - > { no_nickoverride } = 1 ;
2020-02-15 08:17:19 +01:00
if ( $ self - > get_meta ( $ keyword , 'background-process' ) ) {
2020-02-15 07:42:15 +01:00
my $ timeout = $ self - > { pbot } - > { registry } - > get_value ( 'processmanager' , 'default_timeout' ) ;
$ self - > { pbot } - > { process_manager } - > execute_process (
$ stuff ,
sub { $ stuff - > { result } = $ ref - > { subref } - > ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { user } , $ stuff - > { host } , $ stuff - > { arguments } , $ stuff ) } ,
$ timeout
) ;
return "" ;
} else {
my $ result = $ ref - > { subref } - > ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { user } , $ stuff - > { host } , $ stuff - > { arguments } , $ stuff ) ;
return undef if $ stuff - > { referenced } and $ result =~ m/(?:usage:|no results)/i ;
return $ result ;
}
2010-03-22 08:33:44 +01:00
}
}
return undef ;
}
2020-02-01 04:35:22 +01:00
sub set_meta {
my ( $ self , $ command , $ key , $ value , $ save ) = @ _ ;
2020-02-12 06:49:43 +01:00
return undef if not $ self - > { metadata } - > exists ( $ command ) ;
$ self - > { metadata } - > set ( $ command , $ key , $ value , ! $ save ) ;
2020-02-01 04:35:22 +01:00
return 1 ;
}
2020-01-21 01:37:51 +01:00
sub get_meta {
my ( $ self , $ command , $ key ) = @ _ ;
2020-02-12 06:49:43 +01:00
return $ self - > { metadata } - > get_data ( $ command , $ key ) ;
2020-01-21 01:37:51 +01:00
}
2020-01-24 06:09:57 +01:00
sub cmdset {
2020-01-19 06:49:55 +01:00
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments , $ stuff ) = @ _ ;
my ( $ command , $ key , $ value ) = $ self - > { pbot } - > { interpreter } - > split_args ( $ stuff - > { arglist } , 3 ) ;
return "Usage: cmdset <command> [key [value]]" if not defined $ command ;
return $ self - > { metadata } - > set ( $ command , $ key , $ value ) ;
}
2020-01-24 06:09:57 +01:00
sub cmdunset {
2020-01-19 06:49:55 +01:00
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments , $ stuff ) = @ _ ;
my ( $ command , $ key ) = $ self - > { pbot } - > { interpreter } - > split_args ( $ stuff - > { arglist } , 2 ) ;
return "Usage: cmdunset <command> <key>" if not defined $ command or not defined $ key ;
return $ self - > { metadata } - > unset ( $ command , $ key ) ;
}
2020-01-21 01:37:51 +01:00
sub help {
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments , $ stuff ) = @ _ ;
2020-01-19 06:49:55 +01:00
2020-01-21 01:37:51 +01:00
if ( not length $ 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]`." ;
}
2020-01-19 06:49:55 +01:00
2020-01-21 01:37:51 +01:00
my $ keyword = lc $ self - > { pbot } - > { interpreter } - > shift_arg ( $ stuff - > { arglist } ) ;
# check built-in commands first
if ( $ self - > exists ( $ keyword ) ) {
2020-02-12 06:49:43 +01:00
if ( $ self - > { metadata } - > exists ( $ keyword ) ) {
my $ name = $ self - > { metadata } - > get_data ( $ keyword , '_name' ) ;
my $ requires_cap = $ self - > { metadata } - > get_data ( $ keyword , 'requires_cap' ) ;
my $ help = $ self - > { metadata } - > get_data ( $ keyword , 'help' ) ;
2020-01-21 01:37:51 +01:00
my $ result = "/say $name: " ;
2020-02-12 06:49:43 +01:00
$ result . = "[Requires can-$keyword] " if $ requires_cap ;
2020-01-21 01:37:51 +01:00
if ( not defined $ help or not length $ help ) {
$ result . = "I have no help for this command yet." ;
} else {
$ result . = $ help ;
}
return $ result ;
}
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 ( $ stuff - > { arglist } ) ;
$ channel_arg = $ from if not defined $ channel_arg or not length $ channel_arg ;
$ channel_arg = '.*' if $ channel_arg !~ m/^#/ ;
my @ factoids = $ self - > { pbot } - > { factoids } - > find_factoid ( $ channel_arg , $ keyword , exact_trigger = > 1 ) ;
if ( not @ factoids or not $ factoids [ 0 ] ) {
return "I don't know anything about $keyword." ;
}
my ( $ channel , $ trigger ) ;
if ( @ factoids > 1 ) {
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 ] ) ;
}
2020-02-13 22:31:36 +01:00
my $ channel_name = $ self - > { pbot } - > { factoids } - > { factoids } - > get_data ( $ channel , '_name' ) ;
my $ trigger_name = $ self - > { pbot } - > { factoids } - > { factoids } - > get_data ( $ channel , $ trigger , '_name' ) ;
2020-01-21 01:37:51 +01:00
$ channel_name = 'global channel' if $ channel_name eq '.*' ;
$ trigger_name = "\"$trigger_name\"" if $ trigger_name =~ / / ;
my $ result = "/say " ;
$ result . = "[$channel_name] " if $ channel ne $ from and $ channel ne '.*' ;
$ result . = "$trigger_name: " ;
2020-02-13 22:31:36 +01:00
my $ help = $ self - > { pbot } - > { factoids } - > { factoids } - > get_data ( $ channel , $ trigger , 'help' ) ;
2020-01-21 01:37:51 +01:00
if ( not defined $ help or not length $ help ) {
return "/say $trigger_name is a factoid for $channel_name, but I have no help for it yet." ;
}
$ result . = $ help ;
return $ result ;
2020-01-19 06:49:55 +01:00
}
2020-01-24 06:09:57 +01:00
sub uptime {
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments , $ stuff ) = @ _ ;
return localtime ( $ self - > { pbot } - > { startup_timestamp } ) . " [" . duration ( time - $ self - > { pbot } - > { startup_timestamp } ) . "]" ;
}
2020-01-25 21:28:05 +01:00
sub in_channel {
my ( $ self , $ from , $ nick , $ user , $ host , $ arguments , $ stuff ) = @ _ ;
my $ usage = "Usage: in <channel> <command>" ;
return $ usage if not $ arguments ;
2020-02-02 07:17:20 +01:00
my ( $ channel , $ command ) = $ self - > { pbot } - > { interpreter } - > split_args ( $ stuff - > { arglist } , 2 , 0 , 1 ) ;
2020-01-25 21:28:05 +01:00
return $ usage if not defined $ channel or not defined $ command ;
2020-02-02 07:17:20 +01:00
if ( not $ self - > { pbot } - > { nicklist } - > is_present ( $ channel , $ nick ) ) {
return "You must be present in $channel to do this." ;
}
$ stuff - > { from } = $ channel ;
2020-01-25 21:28:05 +01:00
$ stuff - > { command } = $ command ;
return $ self - > { pbot } - > { interpreter } - > interpret ( $ stuff ) ;
}
2010-03-22 08:33:44 +01:00
1 ;