2010-03-22 08:33:44 +01:00
# File: FactoidCommands.pm
2010-03-24 07:47:40 +01:00
# Author: pragma_
2010-03-22 08:33:44 +01:00
#
# Purpose: Administrative command subroutines.
package PBot::FactoidCommands ;
use warnings ;
use strict ;
use Carp ( ) ;
2010-06-21 12:44:15 +02:00
use Time::Duration ;
use Time::HiRes qw( gettimeofday ) ;
2010-03-22 08:33:44 +01:00
sub new {
if ( ref ( $ _ [ 1 ] ) eq 'HASH' ) {
Carp:: croak ( "Options to FactoidCommands should be key/value pairs, not hash reference" ) ;
}
my ( $ class , % conf ) = @ _ ;
my $ self = bless { } , $ class ;
$ self - > initialize ( % conf ) ;
return $ self ;
}
2011-01-25 23:40:22 +01:00
# TODO - move this someplace better so it can be more accessible to user-customisation
my % factoid_metadata_levels = (
created_on = > 999 ,
enabled = > 10 ,
last_referenced_in = > 60 ,
last_referenced_on = > 60 ,
modulelauncher_subpattern = > 60 ,
owner = > 60 ,
rate_limit = > 10 ,
ref_count = > 60 ,
ref_user = > 60 ,
type = > 60 ,
2013-07-31 15:48:50 +02:00
edited_by = > 60 ,
edited_on = > 60 ,
2013-09-13 23:48:19 +02:00
locked = > 10 ,
2014-05-31 03:04:26 +02:00
add_nick = > 10 ,
2014-07-11 14:56:17 +02:00
nooverride = > 10 ,
2011-01-25 23:40:22 +01:00
# all others are allowed to be factset by anybody/default to level 0
) ;
2010-03-22 08:33:44 +01:00
sub initialize {
my ( $ self , % conf ) = @ _ ;
my $ pbot = delete $ conf { pbot } ;
if ( not defined $ pbot ) {
Carp:: croak ( "Missing pbot reference to FactoidCommands" ) ;
}
$ self - > { pbot } = $ pbot ;
2014-12-30 08:15:46 +01:00
$ pbot - > { registry } - > add_default ( 'text' , 'general' , 'module_repo' , $ conf { module_repo } // 'https://github.com/pragma-/pbot/blob/master/modules/' ) ;
2010-03-22 08:33:44 +01:00
2014-05-18 22:09:05 +02:00
$ pbot - > { commands } - > register ( sub { return $ self - > factadd ( @ _ ) } , "learn" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factadd ( @ _ ) } , "factadd" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factrem ( @ _ ) } , "forget" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factrem ( @ _ ) } , "factrem" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factshow ( @ _ ) } , "factshow" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factinfo ( @ _ ) } , "factinfo" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factset ( @ _ ) } , "factset" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factunset ( @ _ ) } , "factunset" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factchange ( @ _ ) } , "factchange" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factalias ( @ _ ) } , "factalias" , 0 ) ;
2014-05-23 14:42:23 +02:00
$ pbot - > { commands } - > register ( sub { return $ self - > factmove ( @ _ ) } , "factmove" , 0 ) ;
2014-05-18 22:09:05 +02:00
$ pbot - > { commands } - > register ( sub { return $ self - > call_factoid ( @ _ ) } , "fact" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > factfind ( @ _ ) } , "factfind" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > list ( @ _ ) } , "list" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > top20 ( @ _ ) } , "top20" , 0 ) ;
2014-05-24 14:01:59 +02:00
$ pbot - > { commands } - > register ( sub { return $ self - > load_module ( @ _ ) } , "load" , 60 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > unload_module ( @ _ ) } , "unload" , 60 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > histogram ( @ _ ) } , "histogram" , 0 ) ;
$ pbot - > { commands } - > register ( sub { return $ self - > count ( @ _ ) } , "count" , 0 ) ;
2010-06-23 04:15:13 +02:00
2010-06-27 04:52:06 +02:00
# the following commands have not yet been updated to use the new factoid structure
# DO NOT USE!! Factoid corruption may occur.
2014-05-18 22:09:05 +02:00
$ pbot - > { commands } - > register ( sub { return $ self - > add_regex ( @ _ ) } , "regex" , 999 ) ;
2010-06-21 15:54:27 +02:00
}
sub call_factoid {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my ( $ chan , $ keyword , $ args ) = split / / , $ arguments , 3 ;
if ( not defined $ chan or not defined $ keyword ) {
2014-05-17 22:08:19 +02:00
return "Usage: fact <channel> <keyword> [arguments]" ;
2010-06-21 15:54:27 +02:00
}
2015-04-10 23:59:17 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ chan , $ keyword , $ args , 1 , 1 ) ;
2010-06-21 15:54:27 +02:00
if ( not defined $ trigger ) {
return "No such factoid '$keyword' exists for channel '$chan'" ;
}
2015-04-10 23:59:17 +02:00
return $ self - > { pbot } - > { factoids } - > interpreter ( $ from , $ nick , $ user , $ host , 1 , $ trigger , $ args , undef , $ channel ) ;
2010-06-20 08:16:48 +02:00
}
sub factset {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my ( $ channel , $ trigger , $ key , $ value ) = split / / , $ arguments , 4 if defined $ arguments ;
if ( not defined $ channel or not defined $ trigger ) {
2014-05-17 22:08:19 +02:00
return "Usage: factset <channel> <factoid> [key [value]]" ;
2010-06-20 08:16:48 +02:00
}
2015-06-06 07:26:02 +02:00
$ channel = '.*' if $ channel !~ /^#/ ;
my ( $ owner_channel , $ owner_trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ channel , $ trigger , undef , 1 , 1 ) ;
my $ admininfo ;
if ( defined $ owner_channel ) {
$ admininfo = $ self - > { pbot } - > { admins } - > loggedin ( $ owner_channel , "$nick!$user\@$host" ) ;
} else {
$ admininfo = $ self - > { pbot } - > { admins } - > loggedin ( $ from , "$nick!$user\@$host" ) ;
}
2011-01-25 23:40:22 +01:00
my $ level = 0 ;
my $ meta_level = 0 ;
if ( defined $ admininfo ) {
$ level = $ admininfo - > { level } ;
}
if ( defined $ key ) {
if ( defined $ factoid_metadata_levels { $ key } ) {
$ meta_level = $ factoid_metadata_levels { $ key } ;
}
if ( $ meta_level > 0 ) {
if ( $ level == 0 ) {
return "You must login to set '$key'" ;
} elsif ( $ level < $ meta_level ) {
return "You must be at least level $meta_level to set '$key'" ;
}
}
}
if ( defined $ owner_channel ) {
2014-05-18 22:09:05 +02:00
my $ factoid = $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { $ owner_channel } - > { $ owner_trigger } ;
2011-01-25 23:40:22 +01:00
2013-07-31 15:29:37 +02:00
my ( $ owner ) = $ factoid - > { 'owner' } =~ m/([^!]+)/ ;
if ( lc $ nick ne lc $ owner and $ level == 0 ) {
2011-01-25 23:40:22 +01:00
return "You are not the owner of $trigger." ;
}
}
2014-05-18 22:09:05 +02:00
return $ self - > { pbot } - > { factoids } - > { factoids } - > set ( $ channel , $ trigger , $ key , $ value ) ;
2010-06-20 08:16:48 +02:00
}
sub factunset {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my ( $ channel , $ trigger , $ key ) = split / / , $ arguments , 3 if defined $ arguments ;
2011-01-25 23:40:22 +01:00
if ( not defined $ channel or not defined $ trigger or not defined $ key ) {
2010-06-21 16:48:40 +02:00
return "Usage: factunset <channel> <factoid> <key>"
2010-06-20 08:16:48 +02:00
}
2015-06-06 07:26:02 +02:00
$ channel = '.*' if $ channel !~ /^#/ ;
my ( $ owner_channel , $ owner_trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ channel , $ trigger , undef , 1 , 1 ) ;
my $ admininfo ;
if ( defined $ owner_channel ) {
$ admininfo = $ self - > { pbot } - > { admins } - > loggedin ( $ owner_channel , "$nick!$user\@$host" ) ;
} else {
$ admininfo = $ self - > { pbot } - > { admins } - > loggedin ( $ from , "$nick!$user\@$host" ) ;
}
2011-01-25 23:40:22 +01:00
my $ level = 0 ;
my $ meta_level = 0 ;
if ( defined $ admininfo ) {
$ level = $ admininfo - > { level } ;
}
if ( defined $ factoid_metadata_levels { $ key } ) {
$ meta_level = $ factoid_metadata_levels { $ key } ;
}
if ( $ meta_level > 0 ) {
if ( $ level == 0 ) {
return "You must login to unset '$key'" ;
} elsif ( $ level < $ meta_level ) {
return "You must be at least level $meta_level to unset '$key'" ;
}
}
if ( defined $ owner_channel ) {
2014-05-18 22:09:05 +02:00
my $ factoid = $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { $ owner_channel } - > { $ owner_trigger } ;
2011-01-25 23:40:22 +01:00
2013-07-31 15:29:37 +02:00
my ( $ owner ) = $ factoid - > { 'owner' } =~ m/([^!]+)/ ;
if ( lc $ nick ne lc $ owner and $ level == 0 ) {
2011-01-25 23:40:22 +01:00
return "You are not the owner of $trigger." ;
}
}
2014-05-18 22:09:05 +02:00
return $ self - > { pbot } - > { factoids } - > { factoids } - > unset ( $ channel , $ trigger , $ key ) ;
2010-03-22 08:33:44 +01:00
}
sub list {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my $ text ;
if ( not defined $ arguments ) {
2014-06-01 23:31:54 +02:00
return "Usage: list <modules|factoids|commands|admins>" ;
2010-03-22 08:33:44 +01:00
}
2014-05-17 22:08:19 +02:00
# TODO - update this to use new MessageHistory API
= cut
2010-03-26 06:14:03 +01:00
if ( $ arguments =~ /^messages\s+(.*)$/ ) {
2011-02-11 03:46:35 +01:00
my ( $ mask_search , $ channel_search , $ text_search ) = split / / , $ 1 ;
2010-03-26 06:14:03 +01:00
2014-04-19 12:37:03 +02:00
return "/msg $nick Usage: list messages <hostmask or nick regex> <channel regex> [text regex]" if not defined $ channel_search ;
2010-03-26 06:14:03 +01:00
$ text_search = '.*' if not defined $ text_search ;
my @ results = eval {
my @ ret ;
2014-05-18 22:09:05 +02:00
foreach my $ history_mask ( keys % { $ self - > { pbot } - > { antiflood } - > message_history } ) {
2011-02-11 03:46:35 +01:00
my $ nickserv = "(undef)" ;
2014-05-18 22:09:05 +02:00
$ nickserv = $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { nickserv_account } if exists $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { nickserv_account } ;
2011-02-11 03:46:35 +01:00
if ( $ history_mask =~ m/$mask_search/i ) {
2014-05-17 22:08:19 +02:00
my $ bot_trigger = $ self - > { pbot } - > { registry } - > get_value ( 'general' , 'trigger' ) ;
2014-05-18 22:09:05 +02:00
foreach my $ history_channel ( keys % { $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { channels } } ) {
2010-03-26 06:14:03 +01:00
if ( $ history_channel =~ m/$channel_search/i ) {
2014-05-18 22:09:05 +02:00
my @ messages = @ { $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { channels } - > { $ history_channel } { messages } } ;
2010-03-26 06:14:03 +01:00
for ( my $ i = 0 ; $ i <= $# messages ; $ i + + ) {
2014-05-17 22:08:19 +02:00
next if $ messages [ $ i ] - > { msg } =~ /^\Q$bot_trigger\E?login/ ; # don't reveal login passwords
2011-02-11 03:46:35 +01:00
print "$history_mask, $history_channel\n" ;
2014-05-18 22:09:05 +02:00
print "joinwatch: " , $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { channels } - > { $ history_channel } { join_watch } , "\n" ;
2011-02-11 03:46:35 +01:00
push @ ret , {
2014-05-18 22:09:05 +02:00
offenses = > $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { channels } - > { $ history_channel } { offenses } ,
last_offense_timestamp = > $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { channels } - > { $ history_channel } { last_offense_timestamp } ,
join_watch = > $ self - > { pbot } - > { antiflood } - > message_history - > { $ history_mask } - > { channels } - > { $ history_channel } { join_watch } ,
2011-02-11 03:46:35 +01:00
text = > $ messages [ $ i ] - > { msg } ,
timestamp = > $ messages [ $ i ] - > { timestamp } ,
mask = > $ history_mask ,
nickserv = > $ nickserv ,
channel = > $ history_channel
} if $ messages [ $ i ] - > { msg } =~ m/$text_search/i ;
2010-03-26 06:14:03 +01:00
}
}
}
}
}
return @ ret ;
} ;
if ( $@ ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "Error in search parameters: $@\n" ) ;
2010-03-26 06:14:03 +01:00
return "Error in search parameters: $@" ;
2010-03-22 08:33:44 +01:00
}
2011-01-27 02:51:16 +01:00
my $ text = "" ;
2011-02-11 03:46:35 +01:00
my % seen_masks = ( ) ;
2010-03-26 06:14:03 +01:00
my @ sorted = sort { $ a - > { timestamp } <=> $ b - > { timestamp } } @ results ;
2011-02-11 03:46:35 +01:00
2010-03-26 06:14:03 +01:00
foreach my $ msg ( @ sorted ) {
2011-02-11 03:46:35 +01:00
if ( not exists $ seen_masks { $ msg - > { mask } } ) {
$ seen_masks { $ msg - > { mask } } = 1 ;
$ text . = "--- [$msg->{mask} [$msg->{nickserv}]: join counter: $msg->{join_watch}; offenses: $msg->{offenses}; last offense/decrease: " . ( $ msg - > { last_offense_timestamp } > 0 ? ago ( gettimeofday - $ msg - > { last_offense_timestamp } ) : "unknown" ) . "]\n" ;
2011-01-27 07:17:39 +01:00
}
2011-02-11 03:46:35 +01:00
$ text . = "[$msg->{channel}] " . localtime ( $ msg - > { timestamp } ) . " <$msg->{mask}> " . $ msg - > { text } . "\n" ;
2010-03-22 08:33:44 +01:00
}
2011-01-27 07:17:39 +01:00
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( $ text ) ;
2011-01-27 07:17:39 +01:00
return "Messages:\n\n$text" ;
2010-03-22 08:33:44 +01:00
}
2014-05-17 22:08:19 +02:00
= cut
2010-03-22 08:33:44 +01:00
if ( $ arguments =~ /^modules$/i ) {
2010-06-21 05:19:41 +02:00
$ from = '.*' if not defined $ from or $ from !~ /^#/ ;
2010-06-20 08:16:48 +02:00
$ text = "Loaded modules for channel $from: " ;
2014-05-18 22:09:05 +02:00
foreach my $ channel ( sort keys % { $ self - > { pbot } - > { factoids } - > { factoids } - > hash } ) {
foreach my $ command ( sort keys % { $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { $ channel } } ) {
if ( $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { $ channel } - > { $ command } - > { type } eq 'module' ) {
2010-06-20 08:16:48 +02:00
$ text . = "$command " ;
}
2010-03-22 08:33:44 +01:00
}
}
return $ text ;
}
if ( $ arguments =~ /^commands$/i ) {
2010-03-23 04:09:03 +01:00
$ text = "Registered commands: " ;
2014-05-18 22:09:05 +02:00
foreach my $ command ( sort { $ a - > { name } cmp $ b - > { name } } @ { $ self - > { pbot } - > { commands } - > { handlers } } ) {
2010-03-23 04:09:03 +01:00
$ text . = "$command->{name} " ;
$ text . = "($command->{level}) " if $ command - > { level } > 0 ;
2010-03-22 08:33:44 +01:00
}
return $ text ;
}
if ( $ arguments =~ /^factoids$/i ) {
2014-05-18 22:09:05 +02:00
return "For a list of factoids see " . $ self - > { pbot } - > { factoids } - > export_site ;
2010-03-22 08:33:44 +01:00
}
if ( $ arguments =~ /^admins$/i ) {
$ text = "Admins: " ;
2010-03-29 14:30:35 +02:00
my $ last_channel = "" ;
my $ sep = "" ;
2014-05-18 22:09:05 +02:00
foreach my $ channel ( sort keys % { $ self - > { pbot } - > { admins } - > { admins } - > hash } ) {
2010-03-29 14:30:35 +02:00
if ( $ last_channel ne $ channel ) {
$ text . = $ sep . "Channel " . ( $ channel eq ".*" ? "all" : $ channel ) . ": " ;
$ last_channel = $ channel ;
$ sep = "" ;
}
2014-05-18 22:09:05 +02:00
foreach my $ hostmask ( sort keys % { $ self - > { pbot } - > { admins } - > { admins } - > hash - > { $ channel } } ) {
2010-03-29 14:30:35 +02:00
$ text . = $ sep ;
2014-05-18 22:09:05 +02:00
$ text . = "*" if exists $ self - > { pbot } - > { admins } - > { admins } - > hash - > { $ channel } - > { $ hostmask } - > { loggedin } ;
$ text . = $ self - > { pbot } - > { admins } - > { admins } - > hash - > { $ channel } - > { $ hostmask } - > { name } . " (" . $ self - > { pbot } - > { admins } - > { admins } - > hash - > { $ channel } - > { $ hostmask } - > { level } . ")" ;
2010-03-29 14:30:35 +02:00
$ sep = "; " ;
}
2010-03-22 08:33:44 +01:00
}
return $ text ;
}
2014-06-01 23:31:54 +02:00
return "Usage: list <modules|commands|factoids|admins>" ;
2010-03-22 08:33:44 +01:00
}
2014-05-23 14:42:23 +02:00
sub factmove {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my ( $ src_channel , $ source , $ target_channel , $ target ) = split / / , $ arguments , 4 if $ arguments ;
my $ usage = "Usage: factmove <source channel> <source factoid> <target channel/factoid> [target factoid]" ;
if ( not defined $ target_channel ) {
return $ usage ;
}
if ( $ target_channel !~ /^#/ and $ target_channel ne '.*' ) {
if ( defined $ target ) {
return "Unexpected argument '$target' when renaming to '$target_channel'. Perhaps '$target_channel' is missing #s? $usage" ;
}
$ target = $ target_channel ;
$ target_channel = $ src_channel ;
} else {
if ( not defined $ target ) {
$ target = $ source ;
}
}
my ( $ found_src_channel , $ found_source ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ src_channel , $ source , undef , 1 , 1 ) ;
if ( not defined $ found_src_channel ) {
return "Source factoid $source not found in channel $src_channel" ;
}
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
my ( $ owner ) = $ factoids - > { $ found_src_channel } - > { $ found_source } - > { 'owner' } =~ m/([^!]+)/ ;
2015-06-06 07:26:02 +02:00
if ( ( lc $ nick ne lc $ owner ) and ( not $ self - > { pbot } - > { admins } - > loggedin ( $ found_src_channel , "$nick!$user\@$host" ) ) ) {
2014-05-23 14:42:23 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host attempted to move [$found_src_channel] $found_source (not owner)\n" ) ;
my $ chan = ( $ found_src_channel eq '.*' ? 'the global channel' : $ found_src_channel ) ;
2014-06-01 23:31:54 +02:00
return "You are not the owner of $found_source for $chan" ;
2014-05-23 14:42:23 +02:00
}
if ( $ factoids - > { $ found_src_channel } - > { $ found_source } - > { 'locked' } ) {
return "$found_source is locked; unlock before moving." ;
}
my ( $ found_target_channel , $ found_target ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ target_channel , $ target , undef , 1 , 1 ) ;
if ( defined $ found_target_channel ) {
return "Target factoid $target already exists in channel $target_channel" ;
}
$ target_channel = lc $ target_channel ;
$ factoids - > { $ target_channel } - > { $ target } = $ factoids - > { $ found_src_channel } - > { $ found_source } ;
delete $ factoids - > { $ found_src_channel } - > { $ found_source } ;
$ self - > { pbot } - > { factoids } - > save_factoids ;
2015-02-16 05:17:36 +01:00
$ found_src_channel = 'global' if $ found_src_channel eq '.*' ;
$ target_channel = 'global' if $ target_channel eq '.*' ;
2014-05-23 14:42:23 +02:00
if ( $ src_channel eq $ target_channel ) {
return "[$found_src_channel] $found_source renamed to $target" ;
} else {
return "[$found_src_channel] $found_source moved to [$target_channel] $target" ;
}
}
2010-06-23 04:15:13 +02:00
sub factalias {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2010-06-23 04:15:13 +02:00
my ( $ chan , $ alias , $ command ) = split / / , $ arguments , 3 if defined $ arguments ;
2010-03-22 08:33:44 +01:00
if ( not defined $ command ) {
2010-06-23 04:15:13 +02:00
return "Usage: factalias <channel> <keyword> <command>" ;
2010-03-22 08:33:44 +01:00
}
2010-06-20 08:16:48 +02:00
2010-07-04 09:26:43 +02:00
$ chan = '.*' if $ chan !~ /^#/ ;
2015-04-10 23:59:17 +02:00
my ( $ channel , $ alias_trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ chan , $ alias , undef , 1 , 1 ) ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
if ( defined $ alias_trigger ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "attempt to overwrite existing command\n" ) ;
2014-06-01 23:31:54 +02:00
return "'$alias_trigger' already exists for channel $channel" ;
2010-03-22 08:33:44 +01:00
}
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > add_factoid ( 'text' , $ chan , "$nick!$user\@$host" , $ alias , "/call $command" ) ;
2010-06-20 08:16:48 +02:00
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host [$chan] aliased $alias => $command\n" ) ;
$ self - > { pbot } - > { factoids } - > save_factoids ( ) ;
2014-06-01 23:31:54 +02:00
return "'$alias' aliases '$command' for " . ( $ chan eq '.*' ? 'the global channel' : $ chan ) ;
2010-03-22 08:33:44 +01:00
}
sub add_regex {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
my ( $ keyword , $ text ) = $ arguments =~ /^(.*?)\s+(.*)$/ if defined $ arguments ;
2010-06-21 05:19:41 +02:00
$ from = '.*' if not defined $ from or $ from !~ /^#/ ;
2010-06-20 08:16:48 +02:00
2010-03-22 08:33:44 +01:00
if ( not defined $ keyword ) {
$ text = "" ;
2014-05-18 22:19:30 +02:00
foreach my $ trigger ( sort keys % { $ factoids - > { $ from } } ) {
if ( $ factoids - > { $ from } - > { $ trigger } - > { type } eq 'regex' ) {
2010-06-20 08:16:48 +02:00
$ text . = $ trigger . " " ;
2010-03-22 08:33:44 +01:00
}
}
2010-06-20 08:16:48 +02:00
return "Stored regexs for channel $from: $text" ;
2010-03-22 08:33:44 +01:00
}
if ( not defined $ text ) {
2010-06-21 16:48:40 +02:00
return "Usage: regex <regex> <command>" ;
2010-03-22 08:33:44 +01:00
}
2015-04-10 23:59:17 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ from , $ keyword , undef , 1 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( defined $ trigger ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host attempt to overwrite $trigger\n" ) ;
2014-06-01 23:31:54 +02:00
return "$trigger already exists for channel $channel." ;
2010-03-22 08:33:44 +01:00
}
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > add_factoid ( 'regex' , $ from , "$nick!$user\@$host" , $ keyword , $ text ) ;
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host added [$keyword] => [$text]\n" ) ;
2014-06-01 23:31:54 +02:00
return "$keyword added." ;
2010-03-22 08:33:44 +01:00
}
2010-06-23 04:15:13 +02:00
sub factadd {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-04-19 12:37:03 +02:00
my ( $ from_chan , $ keyword , $ text ) = $ arguments =~ /^(\S+)\s+(\S+)\s+is\s+(.*)$/i if defined $ arguments ;
2010-03-22 08:33:44 +01:00
2010-06-23 04:15:13 +02:00
if ( not defined $ from_chan or not defined $ text or not defined $ keyword ) {
2014-06-01 23:31:54 +02:00
return "Usage: factadd <channel> <keyword> is <factoid>" ;
2010-03-22 08:33:44 +01:00
}
2010-06-29 07:48:46 +02:00
$ from_chan = '.*' if not $ from_chan =~ m/^#/ ;
2014-05-18 22:09:05 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ from_chan , $ keyword , undef , 1 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( defined $ trigger ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host attempt to overwrite $keyword\n" ) ;
2014-07-11 14:56:17 +02:00
return "$keyword already exists for " . ( $ from_chan eq '.*' ? 'the global channel' : $ from_chan ) . "." ;
}
( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( '.*' , $ keyword , undef , 1 , 1 ) ;
if ( defined $ trigger and $ self - > { pbot } - > { factoids } - > { factoids } - > hash - > { '.*' } - > { $ trigger } - > { 'nooverride' } ) {
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host attempt to override $keyword\n" ) ;
return "$keyword already exists for the global channel and cannot be overridden for " . ( $ from_chan eq '.*' ? 'the global channel' : $ from_chan ) . "." ;
2010-03-22 08:33:44 +01:00
}
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > add_factoid ( 'text' , $ from_chan , "$nick!$user\@$host" , $ keyword , $ text ) ;
2010-03-22 08:33:44 +01:00
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host added [$from_chan] $keyword => $text\n" ) ;
2014-06-01 23:31:54 +02:00
return "$keyword added to " . ( $ from_chan eq '.*' ? 'global channel' : $ from_chan ) . "." ;
2010-03-22 08:33:44 +01:00
}
2010-06-23 04:15:13 +02:00
sub factrem {
2010-06-20 08:16:48 +02:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-06-20 08:16:48 +02:00
2010-06-23 04:15:13 +02:00
my ( $ from_chan , $ from_trigger ) = split / / , $ arguments ;
2010-06-20 08:16:48 +02:00
2010-06-23 04:15:13 +02:00
if ( not defined $ from_chan or not defined $ from_trigger ) {
2014-06-01 23:31:54 +02:00
return "Usage: factrem <channel> <keyword>" ;
2010-06-20 08:16:48 +02:00
}
2014-05-18 22:09:05 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ from_chan , $ from_trigger , undef , 1 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
2014-06-01 23:31:54 +02:00
return "$from_trigger not found in channel $from_chan." ;
2010-06-20 08:16:48 +02:00
}
2014-05-18 22:19:30 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'module' ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host attempted to remove $trigger [not factoid]\n" ) ;
2014-06-01 23:31:54 +02:00
return "$trigger is not a factoid." ;
2010-06-20 08:16:48 +02:00
}
2014-05-18 22:19:30 +02:00
my ( $ owner ) = $ factoids - > { $ channel } - > { $ trigger } - > { 'owner' } =~ m/([^!]+)/ ;
2013-07-31 15:29:37 +02:00
2015-06-06 07:26:02 +02:00
if ( ( lc $ nick ne lc $ owner ) and ( not $ self - > { pbot } - > { admins } - > loggedin ( $ channel , "$nick!$user\@$host" ) ) ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host attempted to remove $trigger [not owner]\n" ) ;
2010-06-29 09:14:26 +02:00
my $ chan = ( $ channel eq '.*' ? 'the global channel' : $ channel ) ;
2014-06-01 23:31:54 +02:00
return "You are not the owner of $trigger for $chan" ;
2010-06-20 08:16:48 +02:00
}
2014-05-23 14:42:23 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { 'locked' } ) {
2013-09-13 23:48:19 +02:00
return "$trigger is locked; unlock before deleting." ;
}
2014-05-18 22:19:30 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host removed [$channel][$trigger][" . $ factoids - > { $ channel } - > { $ trigger } - > { action } . "]\n" ) ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > remove_factoid ( $ channel , $ trigger ) ;
2014-06-01 23:31:54 +02:00
return "$trigger removed from " . ( $ channel eq '.*' ? 'the global channel' : $ channel ) . "." ;
2010-06-20 08:16:48 +02:00
}
2010-03-22 08:33:44 +01:00
sub histogram {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-24 14:01:59 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
my % hash ;
my $ factoid_count = 0 ;
2014-05-24 14:01:59 +02:00
foreach my $ channel ( keys %$ factoids ) {
foreach my $ command ( keys % { $ factoids - > { $ channel } } ) {
if ( $ factoids - > { $ channel } - > { $ command } - > { type } eq 'text' ) {
$ hash { $ factoids - > { $ channel } - > { $ command } - > { owner } } + + ;
$ factoid_count + + ;
}
2010-03-22 08:33:44 +01:00
}
}
my $ text ;
my $ i = 0 ;
foreach my $ owner ( sort { $ hash { $ b } <=> $ hash { $ a } } keys % hash ) {
my $ percent = int ( $ hash { $ owner } / $ factoid_count * 100 ) ;
2014-05-24 14:01:59 +02:00
$ text . = "$owner: $hash{$owner} ($percent" . "%)\n" ;
2010-03-22 08:33:44 +01:00
$ i + + ;
last if $ i >= 10 ;
}
2014-05-24 14:01:59 +02:00
return "$factoid_count factoids, top 10 submitters:\n$text" ;
2010-03-22 08:33:44 +01:00
}
2010-06-23 04:15:13 +02:00
sub factshow {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
2010-06-21 16:41:39 +02:00
my ( $ chan , $ trig ) = split / / , $ arguments ;
if ( not defined $ chan or not defined $ trig ) {
2010-06-23 04:15:13 +02:00
return "Usage: factshow <channel> <trigger>" ;
2010-03-22 08:33:44 +01:00
}
2015-04-27 01:05:03 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ chan , $ trig , undef , 1 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
2014-06-01 23:31:54 +02:00
return "$trig not found in channel $chan" ;
2010-03-22 08:33:44 +01:00
}
2014-05-18 22:19:30 +02:00
my $ result = "$trigger: " . $ factoids - > { $ channel } - > { $ trigger } - > { action } ;
2014-03-05 15:30:02 +01:00
2014-05-18 22:19:30 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'module' ) {
2014-03-05 15:30:02 +01:00
$ result . = ' [module]' ;
2010-03-22 08:33:44 +01:00
}
2014-03-05 15:30:02 +01:00
return $ result ;
2010-03-22 08:33:44 +01:00
}
2010-06-23 04:15:13 +02:00
sub factinfo {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
2010-06-21 16:41:39 +02:00
my ( $ chan , $ trig ) = split / / , $ arguments ;
2010-03-22 08:33:44 +01:00
2010-06-21 16:41:39 +02:00
if ( not defined $ chan or not defined $ trig ) {
2010-06-23 04:15:13 +02:00
return "Usage: factinfo <channel> <trigger>" ;
2010-06-21 16:41:39 +02:00
}
2010-06-20 08:16:48 +02:00
2015-04-27 01:05:03 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ chan , $ trig , undef , 1 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
2014-05-23 14:42:23 +02:00
return "$trig not found in channel $chan" ;
2010-03-22 08:33:44 +01:00
}
2014-05-18 22:19:30 +02:00
my $ created_ago = ago ( gettimeofday - $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) ;
my $ ref_ago = ago ( gettimeofday - $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ) if defined $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ;
2010-06-21 12:44:15 +02:00
2010-06-29 08:12:52 +02:00
$ chan = ( $ channel eq '.*' ? 'global channel' : $ channel ) ;
2010-06-21 15:28:54 +02:00
2010-03-22 08:33:44 +01:00
# factoid
2014-05-18 22:19:30 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'text' ) {
return "$trigger: Factoid submitted by " . $ factoids - > { $ channel } - > { $ trigger } - > { owner } . " for $chan on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) . " [$created_ago], " . ( defined $ factoids - > { $ channel } - > { $ trigger } - > { edited_by } ? "last edited by $factoids->{$channel}->{$trigger}->{edited_by} on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { edited_on } ) . " [" . ago ( gettimeofday - $ factoids - > { $ channel } - > { $ trigger } - > { edited_on } ) . "], " : "" ) . "referenced " . $ factoids - > { $ channel } - > { $ trigger } - > { ref_count } . " times (last by " . $ factoids - > { $ channel } - > { $ trigger } - > { ref_user } . ( exists $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ? " on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ) . " [$ref_ago]" : "" ) . ")" ;
2010-03-22 08:33:44 +01:00
}
# module
2014-05-18 22:19:30 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'module' ) {
2014-12-30 08:15:46 +01:00
my $ module_repo = $ self - > { pbot } - > { registry } - > get_value ( 'general' , 'module_repo' ) ;
2015-03-16 04:12:44 +01:00
$ module_repo . = "$factoids->{$channel}->{$trigger}->{workdir}/" if exists $ factoids - > { $ channel } - > { $ trigger } - > { workdir } ;
2014-12-30 08:15:46 +01:00
return "$trigger: Module loaded by " . $ factoids - > { $ channel } - > { $ trigger } - > { owner } . " for $chan on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) . " [$created_ago] -> $module_repo" . $ factoids - > { $ channel } - > { $ trigger } - > { action } . ", used " . $ factoids - > { $ channel } - > { $ trigger } - > { ref_count } . " times (last by " . $ factoids - > { $ channel } - > { $ trigger } - > { ref_user } . ( exists $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ? " on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ) . " [$ref_ago]" : "" ) . ")" ;
2010-03-22 08:33:44 +01:00
}
# regex
2014-05-18 22:19:30 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'regex' ) {
return "$trigger: Regex created by " . $ factoids - > { $ channel } - > { $ trigger } - > { owner } . " for $chan on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) . " [$created_ago], " . ( defined $ factoids - > { $ channel } - > { $ trigger } - > { edited_by } ? "last edited by $factoids->{$channel}->{$trigger}->{edited_by} on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { edited_on } ) . " [" . ago ( gettimeofday - $ factoids - > { $ channel } - > { $ trigger } - > { edited_on } ) . "], " : "" ) . " used " . $ factoids - > { $ channel } - > { $ trigger } - > { ref_count } . " times (last by " . $ factoids - > { $ channel } - > { $ trigger } - > { ref_user } . ( exists $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ? " on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { last_referenced_on } ) . " [$ref_ago]" : "" ) . ")" ;
2010-03-22 08:33:44 +01:00
}
2014-06-01 23:31:54 +02:00
return "$trigger is not a factoid or a module" ;
2010-03-22 08:33:44 +01:00
}
sub top20 {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
my % hash = ( ) ;
my $ text = "" ;
my $ i = 0 ;
2011-01-27 01:49:36 +01:00
my ( $ channel , $ args ) = split / / , $ arguments , 2 if defined $ arguments ;
if ( not defined $ channel ) {
return "Usage: top20 <channel> [nick or 'recent']" ;
}
if ( not defined $ args ) {
foreach my $ chan ( sort keys % { $ factoids } ) {
next if lc $ chan ne lc $ channel ;
2014-05-18 22:19:30 +02:00
foreach my $ command ( sort { $ factoids - > { $ chan } - > { $ b } { ref_count } <=> $ factoids - > { $ chan } - > { $ a } { ref_count } } keys % { $ factoids - > { $ chan } } ) {
if ( $ factoids - > { $ chan } - > { $ command } { ref_count } > 0 and $ factoids - > { $ chan } - > { $ command } { type } eq 'text' ) {
$ text . = "$command ($factoids->{$chan}->{$command}{ref_count}) " ;
2011-01-27 01:49:36 +01:00
$ i + + ;
last if $ i >= 20 ;
}
2010-03-22 08:33:44 +01:00
}
2011-01-27 01:49:36 +01:00
$ channel = "the global channel" if $ channel eq '.*' ;
$ text = "Top $i referenced factoids for $channel: $text" if $ i > 0 ;
return $ text ;
2010-03-22 08:33:44 +01:00
}
2011-01-27 01:49:36 +01:00
2010-03-22 08:33:44 +01:00
} else {
2011-01-27 01:49:36 +01:00
if ( lc $ args eq "recent" ) {
foreach my $ chan ( sort keys % { $ factoids } ) {
next if lc $ chan ne lc $ channel ;
2014-05-18 22:19:30 +02:00
foreach my $ command ( sort { $ factoids - > { $ chan } - > { $ b } { created_on } <=> $ factoids - > { $ chan } - > { $ a } { created_on } } keys % { $ factoids - > { $ chan } } ) {
my $ ago = ago ( gettimeofday - $ factoids - > { $ chan } - > { $ command } - > { created_on } ) ;
$ text . = " $command [$ago by $factoids->{$chan}->{$command}->{owner}]\n" ;
2011-01-27 01:49:36 +01:00
$ i + + ;
last if $ i >= 50 ;
}
$ channel = "global channel" if $ channel eq '.*' ;
$ text = "$i most recent $channel submissions:\n\n$text" if $ i > 0 ;
return $ text ;
2010-03-22 08:33:44 +01:00
}
}
2011-01-27 01:49:36 +01:00
my $ user = lc $ args ;
foreach my $ chan ( sort keys % { $ factoids } ) {
next if lc $ chan ne lc $ channel ;
2014-05-18 22:19:30 +02:00
foreach my $ command ( sort { ( $ factoids - > { $ chan } - > { $ b } { last_referenced_on } || 0 ) <=> ( $ factoids - > { $ chan } - > { $ a } { last_referenced_on } || 0 ) } keys % { $ factoids - > { $ chan } } ) {
if ( $ factoids - > { $ chan } - > { $ command } { ref_user } =~ /\Q$args\E/i ) {
if ( $ user ne lc $ factoids - > { $ chan } - > { $ command } { ref_user } && not $ user =~ /$factoids->{$chan}->{$command}{ref_user}/i ) {
$ user . = " ($factoids->{$chan}->{$command}{ref_user})" ;
2011-01-27 01:49:36 +01:00
}
2014-05-18 22:19:30 +02:00
my $ ago = $ factoids - > { $ chan } - > { $ command } { last_referenced_on } ? ago ( gettimeofday - $ factoids - > { $ chan } - > { $ command } { last_referenced_on } ) : "unknown" ;
2011-01-27 01:49:36 +01:00
$ text . = " $command [$ago]\n" ;
$ i + + ;
last if $ i >= 20 ;
2010-03-22 08:33:44 +01:00
}
}
2011-01-27 01:49:36 +01:00
$ text = "$i factoids last referenced by $user:\n\n$text" if $ i > 0 ;
return $ text ;
2010-03-22 08:33:44 +01:00
}
}
}
sub count {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-24 14:01:59 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
my $ i = 0 ;
my $ total = 0 ;
if ( not defined $ arguments ) {
2014-06-01 23:31:54 +02:00
return "Usage: count <nick|factoids>" ;
2010-03-22 08:33:44 +01:00
}
$ arguments = ".*" if ( $ arguments =~ /^factoids$/ ) ;
eval {
2014-05-24 14:01:59 +02:00
foreach my $ channel ( keys % { $ factoids } ) {
foreach my $ command ( keys % { $ factoids - > { $ channel } } ) {
next if $ factoids - > { $ channel } - > { $ command } - > { type } ne 'text' ;
$ total + + ;
if ( $ factoids - > { $ channel } - > { $ command } - > { owner } =~ /\Q$arguments\E/i ) {
$ i + + ;
}
2010-03-22 08:33:44 +01:00
}
}
} ;
return "/msg $nick $arguments: $@" if $@ ;
2014-05-24 14:01:59 +02:00
return "I have $i factoids." if $ arguments eq ".*" ;
2010-03-22 08:33:44 +01:00
if ( $ i > 0 ) {
my $ percent = int ( $ i / $ total * 100 ) ;
$ percent = 1 if $ percent == 0 ;
return "$arguments has submitted $i factoids out of $total ($percent" . "%)" ;
} else {
return "$arguments hasn't submitted any factoids" ;
}
}
2010-06-29 06:33:27 +02:00
sub factfind {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-06-21 16:41:39 +02:00
2010-03-26 09:58:25 +01:00
if ( not defined $ arguments ) {
2014-06-01 23:31:54 +02:00
return "Usage: factfind [-channel channel] [-owner regex] [-editby regex] [-refby regex] [text]" ;
2010-03-26 09:58:25 +01:00
}
2014-06-01 23:31:54 +02:00
my ( $ channel , $ owner , $ refby , $ editby ) ;
2010-03-26 09:58:25 +01:00
2010-06-29 06:33:27 +02:00
$ channel = $ 1 if $ arguments =~ s/-channel\s+([^\b\s]+)//i ;
2010-03-26 09:58:25 +01:00
$ owner = $ 1 if $ arguments =~ s/-owner\s+([^\b\s]+)//i ;
2014-06-01 23:31:54 +02:00
$ refby = $ 1 if $ arguments =~ s/-refby\s+([^\b\s]+)//i ;
$ editby = $ 1 if $ arguments =~ s/-editby\s+([^\b\s]+)//i ;
2010-03-26 09:58:25 +01:00
$ owner = '.*' if not defined $ owner ;
2014-06-01 23:31:54 +02:00
$ refby = '.*' if not defined $ refby ;
$ editby = '.*' if not defined $ editby ;
2010-03-26 09:58:25 +01:00
$ arguments =~ s/^\s+// ;
$ arguments =~ s/\s+$// ;
$ arguments =~ s/\s+/ /g ;
my $ argtype = undef ;
if ( $ owner ne '.*' ) {
$ argtype = "owned by $owner" ;
}
2014-06-01 23:31:54 +02:00
if ( $ refby ne '.*' ) {
if ( not defined $ argtype ) {
$ argtype = "last referenced by $refby" ;
} else {
$ argtype . = " and last referenced by $refby" ;
}
}
if ( $ editby ne '.*' ) {
2010-03-26 09:58:25 +01:00
if ( not defined $ argtype ) {
2014-06-01 23:31:54 +02:00
$ argtype = "last edited by $editby" ;
2010-03-26 09:58:25 +01:00
} else {
2014-06-01 23:31:54 +02:00
$ argtype . = " and last edited by $editby" ;
2010-03-26 09:58:25 +01:00
}
}
if ( $ arguments ne "" ) {
2014-03-04 11:48:08 +01:00
my $ unquoted_args = $ arguments ;
$ unquoted_args =~ s/(?:\\(?!\\))//g ;
$ unquoted_args =~ s/(?:\\\\)/\\/g ;
2010-03-26 09:58:25 +01:00
if ( not defined $ argtype ) {
2014-03-04 11:48:08 +01:00
$ argtype = "with text containing '$unquoted_args'" ;
2010-03-26 09:58:25 +01:00
} else {
2014-03-04 11:48:08 +01:00
$ argtype . = " and with text containing '$unquoted_args'" ;
2010-03-26 09:58:25 +01:00
}
}
if ( not defined $ argtype ) {
2014-06-01 23:31:54 +02:00
return "Usage: factfind [-channel] [-owner regex] [-refby regex] [-editby regex] [text]" ;
2010-03-26 09:58:25 +01:00
}
2010-06-29 06:33:27 +02:00
my ( $ text , $ last_trigger , $ last_chan , $ i ) ;
$ last_chan = "" ;
$ i = 0 ;
2010-03-26 09:58:25 +01:00
eval {
2010-06-29 06:33:27 +02:00
foreach my $ chan ( sort keys % { $ factoids } ) {
next if defined $ channel and $ chan !~ /$channel/i ;
2014-05-18 22:19:30 +02:00
foreach my $ trigger ( sort keys % { $ factoids - > { $ chan } } ) {
if ( $ factoids - > { $ chan } - > { $ trigger } - > { type } eq 'text' or $ factoids - > { $ chan } - > { $ trigger } - > { type } eq 'regex' ) {
2014-06-01 23:31:54 +02:00
if ( $ factoids - > { $ chan } - > { $ trigger } - > { owner } =~ /$owner/i
&& $ factoids - > { $ chan } - > { $ trigger } - > { ref_user } =~ /$refby/i
2014-10-14 04:30:14 +02:00
&& ( exists $ factoids - > { $ chan } - > { $ trigger } - > { edited_by } ? $ factoids - > { $ chan } - > { $ trigger } - > { edited_by } =~ /$editby/i : 1 ) ) {
2014-05-18 22:19:30 +02:00
next if ( $ arguments ne "" && $ factoids - > { $ chan } - > { $ trigger } - > { action } !~ /$arguments/i && $ trigger !~ /$arguments/i ) ;
2010-06-29 06:33:27 +02:00
$ i + + ;
if ( $ chan ne $ last_chan ) {
2010-06-29 08:12:52 +02:00
$ text . = $ chan eq '.*' ? "[global channel] " : "[$chan] " ;
2010-06-29 06:33:27 +02:00
$ last_chan = $ chan ;
}
$ text . = "$trigger " ;
$ last_trigger = $ trigger ;
}
2010-03-22 08:33:44 +01:00
}
2010-03-26 09:58:25 +01:00
}
2010-03-22 08:33:44 +01:00
}
2010-03-26 09:58:25 +01:00
} ;
return "/msg $nick $arguments: $@" if $@ ;
2010-03-22 08:33:44 +01:00
if ( $ i == 1 ) {
chop $ text ;
2014-05-24 14:01:59 +02:00
return "Found one factoid submitted for " . ( $ last_chan eq '.*' ? 'global channel' : $ last_chan ) . " " . $ argtype . ": $last_trigger is $factoids->{$last_chan}->{$last_trigger}->{action}" ;
2010-03-22 08:33:44 +01:00
} else {
2014-05-24 14:01:59 +02:00
return "Found $i factoids " . $ argtype . ": $text" unless $ i == 0 ;
2010-06-29 06:33:27 +02:00
2010-06-29 08:12:52 +02:00
my $ chans = ( defined $ channel ? ( $ channel eq '.*' ? 'global channel' : $ channel ) : 'any channels' ) ;
2010-06-29 06:33:27 +02:00
return "No factoids " . $ argtype . " submitted for $chans" ;
2010-03-22 08:33:44 +01:00
}
}
2010-06-23 04:15:13 +02:00
sub factchange {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-18 22:09:05 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-06-23 04:15:13 +02:00
my ( $ channel , $ trigger , $ keyword , $ delim , $ tochange , $ changeto , $ modifier ) ;
2010-03-22 08:33:44 +01:00
if ( defined $ arguments ) {
2010-06-23 04:15:13 +02:00
if ( $ arguments =~ /^([^\s]+) ([^\s]+)\s+s(.)/ ) {
$ channel = $ 1 ;
$ keyword = $ 2 ;
$ delim = $ 3 ;
2010-03-22 08:33:44 +01:00
}
if ( $ arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/ ) {
$ tochange = $ 1 ;
$ changeto = $ 2 ;
$ modifier = $ 3 ;
}
}
2010-06-23 04:15:13 +02:00
if ( not defined $ channel or not defined $ changeto ) {
2010-06-23 04:18:26 +02:00
return "Usage: factchange <channel> <keyword> s/<pattern>/<replacement>/" ;
2010-03-22 08:33:44 +01:00
}
2015-04-10 23:59:17 +02:00
( $ channel , $ trigger ) = $ self - > { pbot } - > { factoids } - > find_factoid ( $ channel , $ keyword , undef , 1 , 1 ) ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
2014-06-01 23:31:54 +02:00
return "$keyword not found in channel $from." ;
2010-06-20 08:16:48 +02:00
}
2010-03-22 08:33:44 +01:00
2014-05-23 14:42:23 +02:00
if ( not $ self - > { pbot } - > { admins } - > loggedin ( $ from , "$nick!$user\@$host" ) and $ factoids - > { $ channel } - > { $ trigger } - > { 'locked' } ) {
2013-09-13 23:48:19 +02:00
return "$trigger is locked and cannot be changed." ;
}
2010-03-22 08:33:44 +01:00
my $ ret = eval {
2014-04-29 19:00:51 +02:00
use re::engine::RE2 - strict = > 1 ;
2014-05-18 22:19:30 +02:00
if ( not $ factoids - > { $ channel } - > { $ trigger } - > { action } =~ s | $ tochange | $ changeto | ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "($from) $nick!$user\@$host: failed to change '$trigger' 's$delim$tochange$delim$changeto$delim\n" ) ;
2014-06-01 23:31:54 +02:00
return "Change $trigger failed." ;
2010-03-22 08:33:44 +01:00
} else {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "($from) $nick!$user\@$host: changed '$trigger' 's/$tochange/$changeto/\n" ) ;
2014-05-18 22:19:30 +02:00
$ factoids - > { $ channel } - > { $ trigger } - > { edited_by } = "$nick!$user\@$host" ;
$ factoids - > { $ channel } - > { $ trigger } - > { edited_on } = gettimeofday ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > save_factoids ( ) ;
2014-05-18 22:19:30 +02:00
return "Changed: $trigger is " . $ factoids - > { $ channel } - > { $ trigger } - > { action } ;
2010-03-22 08:33:44 +01:00
}
} ;
2010-06-20 08:16:48 +02:00
return "/msg $nick Change $trigger: $@" if $@ ;
2010-03-22 08:33:44 +01:00
return $ ret ;
}
sub load_module {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-24 14:01:59 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
my ( $ keyword , $ module ) = $ arguments =~ /^(.*?)\s+(.*)$/ if defined $ arguments ;
2010-03-28 13:19:54 +02:00
if ( not defined $ module ) {
2014-06-01 23:31:54 +02:00
return "Usage: load <keyword> <module>" ;
2010-03-22 08:33:44 +01:00
}
2014-05-24 14:01:59 +02:00
if ( not exists ( $ factoids - > { '.*' } - > { $ keyword } ) ) {
$ self - > { pbot } - > { factoids } - > add_factoid ( 'module' , '.*' , "$nick!$user\@$host" , $ keyword , $ module ) ;
$ factoids - > { '.*' } - > { $ keyword } - > { add_nick } = 1 ;
2014-07-11 14:56:17 +02:00
$ factoids - > { '.*' } - > { $ keyword } - > { nooverride } = 1 ;
2014-05-24 14:01:59 +02:00
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host loaded module $keyword => $module\n" ) ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > save_factoids ( ) ;
2014-06-01 23:31:54 +02:00
return "Loaded module $keyword => $module" ;
2010-03-22 08:33:44 +01:00
} else {
2014-06-01 23:31:54 +02:00
return "There is already a keyword named $keyword." ;
2010-03-22 08:33:44 +01:00
}
}
sub unload_module {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
2014-05-24 14:01:59 +02:00
my $ factoids = $ self - > { pbot } - > { factoids } - > { factoids } - > hash ;
2010-03-22 08:33:44 +01:00
if ( not defined $ arguments ) {
2014-06-01 23:31:54 +02:00
return "Usage: unload <keyword>" ;
2014-05-24 14:01:59 +02:00
} elsif ( not exists $ factoids - > { '.*' } - > { $ arguments } ) {
2014-06-01 23:31:54 +02:00
return "$arguments not found." ;
2014-05-24 14:01:59 +02:00
} elsif ( $ factoids - > { '.*' } - > { $ arguments } { type } ne 'module' ) {
2014-06-01 23:31:54 +02:00
return "$arguments is not a module." ;
2010-03-22 08:33:44 +01:00
} else {
2014-05-24 14:01:59 +02:00
delete $ factoids - > { '.*' } - > { $ arguments } ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { factoids } - > save_factoids ( ) ;
$ self - > { pbot } - > { logger } - > log ( "$nick!$user\@$host unloaded module $arguments\n" ) ;
2014-06-01 23:31:54 +02:00
return "$arguments unloaded." ;
2010-03-22 08:33:44 +01:00
}
}
1 ;