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 ;
2010-03-24 07:47:40 +01:00
use vars qw( $VERSION ) ;
$ VERSION = $ PBot:: PBot:: VERSION ;
2010-03-22 08:33:44 +01:00
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 ,
# 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 ;
2010-06-23 04:15:13 +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 ) ;
2011-01-25 23:40:22 +01:00
$ pbot - > commands - > register ( sub { return $ self - > factset ( @ _ ) } , "factset" , 0 ) ;
$ pbot - > commands - > register ( sub { return $ self - > factunset ( @ _ ) } , "factunset" , 0 ) ;
2010-06-23 04:15:13 +02:00
$ pbot - > commands - > register ( sub { return $ self - > factchange ( @ _ ) } , "factchange" , 0 ) ;
$ pbot - > commands - > register ( sub { return $ self - > factalias ( @ _ ) } , "factalias" , 0 ) ;
$ pbot - > commands - > register ( sub { return $ self - > call_factoid ( @ _ ) } , "fact" , 0 ) ;
2010-06-29 06:33:27 +02:00
$ pbot - > commands - > register ( sub { return $ self - > factfind ( @ _ ) } , "factfind" , 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.
2010-06-29 06:33:27 +02:00
$ pbot - > commands - > register ( sub { return $ self - > list ( @ _ ) } , "list" , 0 ) ;
2010-06-27 04:52:06 +02:00
$ pbot - > commands - > register ( sub { return $ self - > add_regex ( @ _ ) } , "regex" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > histogram ( @ _ ) } , "histogram" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > top20 ( @ _ ) } , "top20" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > count ( @ _ ) } , "count" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > load_module ( @ _ ) } , "load" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > unload_module ( @ _ ) } , "unload" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > enable_command ( @ _ ) } , "enable" , 999 ) ;
$ pbot - > commands - > register ( sub { return $ self - > disable_command ( @ _ ) } , "disable" , 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 ) {
return "Usage: !fact <channel> <keyword> [arguments]" ;
}
my ( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ chan , $ keyword , $ args , 1 ) ;
if ( not defined $ trigger ) {
return "No such factoid '$keyword' exists for channel '$chan'" ;
}
return $ self - > { pbot } - > factoids - > interpreter ( $ channel , $ nick , $ user , $ host , 1 , $ trigger , $ args ) ;
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 ) {
2010-06-21 16:48:40 +02:00
return "Usage: factset <channel> <factoid> [key <value>]"
2010-06-20 08:16:48 +02:00
}
2011-01-25 23:40:22 +01:00
my $ admininfo = $ self - > { pbot } - > admins - > loggedin ( $ from , "$nick!$user\@$host" ) ;
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'" ;
}
}
}
my ( $ owner_channel , $ owner_trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ channel , $ trigger , undef , 1 ) ;
if ( defined $ owner_channel ) {
my $ factoid = $ self - > { pbot } - > factoids - > factoids - > hash - > { $ owner_channel } - > { $ owner_trigger } ;
if ( lc $ nick ne lc $ factoid - > { 'owner' } and $ level == 0 ) {
return "You are not the owner of $trigger." ;
}
}
2010-06-21 13:44:39 +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
}
2011-01-25 23:40:22 +01:00
my $ admininfo = $ self - > { pbot } - > admins - > loggedin ( $ from , "$nick!$user\@$host" ) ;
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'" ;
}
}
my ( $ owner_channel , $ owner_trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ channel , $ trigger , undef , 1 ) ;
if ( defined $ owner_channel ) {
my $ factoid = $ self - > { pbot } - > factoids - > factoids - > hash - > { $ owner_channel } - > { $ owner_trigger } ;
if ( lc $ nick ne lc $ factoid - > { 'owner' } and $ level == 0 ) {
return "You are not the owner of $trigger." ;
}
}
2010-06-21 16:48:40 +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 ) = @ _ ;
2010-03-26 06:14:03 +01:00
my $ botnick = $ self - > { pbot } - > botnick ;
2010-03-22 08:33:44 +01:00
my $ text ;
if ( not defined $ arguments ) {
return "/msg $nick Usage: list <modules|factoids|commands|admins>" ;
}
2010-03-26 06:14:03 +01:00
if ( $ arguments =~ /^messages\s+(.*)$/ ) {
my ( $ nick_search , $ channel_search , $ text_search ) = split / / , $ 1 ;
return "/msg $nick Usage: !list messages <nick regex> <channel regex> [text regex]" if not defined $ channel_search ;
$ text_search = '.*' if not defined $ text_search ;
my @ results = eval {
my @ ret ;
foreach my $ history_nick ( keys % { $ self - > { pbot } - > antiflood - > message_history } ) {
if ( $ history_nick =~ m/$nick_search/i ) {
foreach my $ history_channel ( keys % { $ self - > { pbot } - > antiflood - > message_history - > { $ history_nick } } ) {
2010-06-06 09:22:23 +02:00
next if $ history_channel eq 'hostmask' ; # TODO: move channels into {channel} subkey
2010-03-26 06:14:03 +01:00
if ( $ history_channel =~ m/$channel_search/i ) {
my @ messages = @ { $ { $ self - > { pbot } - > antiflood - > message_history } { $ history_nick } { $ history_channel } { messages } } ;
for ( my $ i = 0 ; $ i <= $# messages ; $ i + + ) {
next if $ messages [ $ i ] - > { msg } =~ /^!login/ ;
2010-06-06 02:34:27 +02:00
push @ ret , { offenses = > $ { $ self - > { pbot } - > antiflood - > message_history } { $ history_nick } { $ history_channel } { offenses } , join_watch = > $ { $ self - > { pbot } - > antiflood - > message_history } { $ history_nick } { $ history_channel } { join_watch } , text = > $ messages [ $ i ] - > { msg } , timestamp = > $ messages [ $ i ] - > { timestamp } , nick = > $ history_nick , channel = > $ history_channel } if $ messages [ $ i ] - > { msg } =~ m/$text_search/i ;
2010-03-26 06:14:03 +01:00
}
}
}
}
}
return @ ret ;
} ;
if ( $@ ) {
$ self - > { pbot } - > logger - > log ( "Error in search parameters: $@\n" ) ;
return "Error in search parameters: $@" ;
2010-03-22 08:33:44 +01:00
}
2010-03-26 06:14:03 +01:00
my @ sorted = sort { $ a - > { timestamp } <=> $ b - > { timestamp } } @ results ;
foreach my $ msg ( @ sorted ) {
2010-06-06 02:34:27 +02:00
$ self - > { pbot } - > logger - > log ( "[$msg->{channel}] " . localtime ( $ msg - > { timestamp } ) . " [o: $msg->{offenses}, j: $msg->{join_watch}] <$msg->{nick}> " . $ msg - > { text } . "\n" ) ;
2010-03-26 06:14:03 +01:00
$ self - > { pbot } - > conn - > privmsg ( $ nick , "[$msg->{channel}] " . localtime ( $ msg - > { timestamp } ) . " <$msg->{nick}> " . $ msg - > { text } . "\n" ) unless $ nick =~ /\Q$botnick\E/i ;
2010-03-22 08:33:44 +01:00
}
return "" ;
}
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: " ;
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' ) {
$ 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: " ;
foreach my $ command ( sort { $ a - > { name } cmp $ b - > { name } } @ { $ self - > { pbot } - > commands - > { handlers } } ) {
$ text . = "$command->{name} " ;
$ text . = "($command->{level}) " if $ command - > { level } > 0 ;
2010-03-22 08:33:44 +01:00
}
return $ text ;
}
if ( $ arguments =~ /^factoids$/i ) {
2010-03-23 04:09:03 +01: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 = "" ;
2010-08-15 10:25:35 +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 = "" ;
}
2010-08-15 10:25:35 +02:00
foreach my $ hostmask ( sort keys % { $ self - > { pbot } - > admins - > admins - > hash - > { $ channel } } ) {
2010-03-29 14:30:35 +02:00
$ text . = $ sep ;
2010-08-15 10:25:35 +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 ;
}
return "/msg $nick Usage: list <modules|commands|factoids|admins>" ;
}
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 !~ /^#/ ;
2010-06-23 04:15:13 +02:00
my ( $ channel , $ alias_trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ chan , $ alias , undef , 1 ) ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
if ( defined $ alias_trigger ) {
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > logger - > log ( "attempt to overwrite existing command\n" ) ;
2010-06-20 08:16:48 +02:00
return "/msg $nick '$alias_trigger' already exists for channel $channel" ;
2010-03-22 08:33:44 +01:00
}
2010-06-23 04:15:13 +02:00
$ self - > { pbot } - > factoids - > add_factoid ( 'text' , $ chan , $ nick , $ alias , "/call $command" ) ;
2010-06-20 08:16:48 +02:00
2010-06-23 04:15:13 +02:00
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host [$chan] aliased $alias => $command\n" ) ;
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > factoids - > save_factoids ( ) ;
2010-07-04 09:36:51 +02:00
return "/msg $nick '$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 ) = @ _ ;
2010-06-20 08:16:48 +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 = "" ;
2010-06-20 08:16:48 +02:00
foreach my $ trigger ( sort keys % { $ factoids - > { $ from } } ) {
if ( $ factoids - > { $ from } - > { $ trigger } - > { type } eq 'regex' ) {
$ 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
}
2010-06-21 15:28:54 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ from , $ keyword , undef , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( defined $ trigger ) {
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host attempt to overwrite $trigger\n" ) ;
return "/msg $nick $trigger already exists for channel $channel." ;
2010-03-22 08:33:44 +01:00
}
2010-06-20 08:16:48 +02:00
$ self - > { pbot } - > factoids - > add_factoid ( 'regex' , $ from , $ nick , $ keyword , $ text ) ;
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host added [$keyword] => [$text]\n" ) ;
return "/msg $nick $keyword added." ;
}
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 ) = @ _ ;
2010-06-23 04:15:13 +02:00
my ( $ from_chan , $ keyword , $ text ) = $ arguments =~ /^(.*?)\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 ) {
return "/msg $nick 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/^#/ ;
2010-06-27 04:52:06 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ from_chan , $ keyword , undef , 1 , 1 ) ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
if ( defined $ trigger ) {
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host attempt to overwrite $keyword\n" ) ;
2010-06-30 12:59:50 +02:00
return "/msg $nick $keyword already exists for " . ( $ from_chan eq '.*' ? 'global channel' : $ from_chan ) . "." ;
2010-03-22 08:33:44 +01:00
}
2010-06-23 04:15:13 +02:00
$ self - > { pbot } - > factoids - > add_factoid ( 'text' , $ from_chan , $ nick , $ keyword , $ text ) ;
2010-03-22 08:33:44 +01:00
2010-06-29 07:48:46 +02:00
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host added [$from_chan] $keyword => $text\n" ) ;
2010-06-29 08:12:52 +02:00
return "/msg $nick '$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 ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids - > hash ;
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 ) {
return "/msg $nick Usage: factrem <channel> <keyword>" ;
2010-06-20 08:16:48 +02:00
}
2010-06-27 04:52:06 +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 ) {
2010-06-23 04:15:13 +02:00
return "/msg $nick $from_trigger not found in channel $from_chan." ;
2010-06-20 08:16:48 +02:00
}
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'module' ) {
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host attempted to remove $trigger [not factoid]\n" ) ;
return "/msg $nick $trigger is not a factoid." ;
}
if ( ( $ nick ne $ factoids - > { $ channel } - > { $ trigger } - > { owner } ) and ( not $ self - > { pbot } - > admins - > loggedin ( $ from , "$nick!$user\@$host" ) ) ) {
$ 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 ) ;
return "/msg $nick You are not the owner of '$trigger' for $chan" ;
2010-06-20 08:16:48 +02:00
}
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host removed [$channel][$trigger][" . $ factoids - > { $ channel } - > { $ trigger } - > { action } . "]\n" ) ;
$ self - > { pbot } - > factoids - > remove_factoid ( $ channel , $ trigger ) ;
2010-06-29 09:14:26 +02:00
return "/msg $nick $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 ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
my % hash ;
my $ factoid_count = 0 ;
foreach my $ command ( keys % { $ factoids } ) {
if ( exists $ factoids - > { $ command } { text } ) {
$ hash { $ factoids - > { $ command } { owner } } + + ;
$ factoid_count + + ;
}
}
my $ text ;
my $ i = 0 ;
foreach my $ owner ( sort { $ hash { $ b } <=> $ hash { $ a } } keys % hash ) {
my $ percent = int ( $ hash { $ owner } / $ factoid_count * 100 ) ;
$ percent = 1 if $ percent == 0 ;
$ text . = "$owner: $hash{$owner} ($percent" . "%) " ;
$ i + + ;
last if $ i >= 10 ;
}
2010-03-26 09:58:25 +01:00
return "$factoid_count factoids, top 10 submitters: $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 ) = @ _ ;
2010-06-20 08:16:48 +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
}
2010-06-27 04:52:06 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ chan , $ trig , undef , 0 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
2010-06-23 04:15:13 +02:00
return "/msg $nick '$trig' not found in channel '$chan'" ;
2010-03-22 08:33:44 +01:00
}
2010-06-20 08:16:48 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'module' ) {
return "/msg $nick $trigger is not a factoid" ;
2010-03-22 08:33:44 +01:00
}
2010-06-20 08:16:48 +02:00
return "$trigger: " . $ factoids - > { $ channel } - > { $ trigger } - > { action } ;
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 ) = @ _ ;
2010-06-20 08:16:48 +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
2010-06-27 04:52:06 +02:00
my ( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ chan , $ trig , undef , 0 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
2010-06-23 04:15:13 +02:00
return "'$trig' not found in channel '$chan'" ;
2010-03-22 08:33:44 +01:00
}
2010-06-21 12:44:15 +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-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
2010-06-20 08:16:48 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'text' ) {
2010-06-21 15:28:54 +02:00
return "$trigger: Factoid submitted by " . $ factoids - > { $ channel } - > { $ trigger } - > { owner } . " for $chan on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) . " [$created_ago], 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
2010-06-20 08:16:48 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'module' ) {
2010-06-21 15:28:54 +02:00
return "$trigger: Module loaded by " . $ factoids - > { $ channel } - > { $ trigger } - > { owner } . " for $chan on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) . " [$created_ago] -> http://code.google.com/p/pbot2-pl/source/browse/trunk/modules/" . $ 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
2010-06-20 08:16:48 +02:00
if ( $ factoids - > { $ channel } - > { $ trigger } - > { type } eq 'regex' ) {
2010-06-21 15:28:54 +02:00
return "$trigger: Regex created by " . $ factoids - > { $ channel } - > { $ trigger } - > { owner } . " for $chan on " . localtime ( $ factoids - > { $ channel } - > { $ trigger } - > { created_on } ) . " [$created_ago], 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
}
2010-06-20 08:16:48 +02:00
return "/msg $nick $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 ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
my % hash = ( ) ;
my $ text = "" ;
my $ i = 0 ;
if ( not defined $ arguments ) {
foreach my $ command ( sort { $ factoids - > { $ b } { ref_count } <=> $ factoids - > { $ a } { ref_count } } keys % { $ factoids } ) {
if ( $ factoids - > { $ command } { ref_count } > 0 && exists $ factoids - > { $ command } { text } ) {
$ text . = "$command ($factoids->{$command}{ref_count}) " ;
$ i + + ;
last if $ i >= 20 ;
}
}
$ text = "Top $i referenced factoids: $text" if $ i > 0 ;
return $ text ;
} else {
if ( lc $ arguments eq "recent" ) {
2010-05-09 01:36:56 +02:00
foreach my $ command ( sort { $ factoids - > { $ b } { created_on } <=> $ factoids - > { $ a } { created_on } } keys % { $ factoids } ) {
#my ($seconds, $minutes, $hours, $day_of_month, $month, $year, $wday, $yday, $isdst) = localtime($factoids->{$command}{created_on});
2010-03-22 08:33:44 +01:00
#my $t = sprintf("%04d/%02d/%02d", $year+1900, $month+1, $day_of_month);
$ text . = "$command " ;
$ i + + ;
last if $ i >= 50 ;
}
$ text = "$i most recent submissions: $text" if $ i > 0 ;
return $ text ;
}
my $ user = lc $ arguments ;
foreach my $ command ( sort keys % { $ factoids } ) {
if ( $ factoids - > { $ command } { ref_user } =~ /\Q$arguments\E/i ) {
if ( $ user ne lc $ factoids - > { $ command } { ref_user } && not $ user =~ /$factoids->{$command}{ref_user}/i ) {
$ user . = " ($factoids->{$command}{ref_user})" ;
}
$ text . = "$command " ;
$ i + + ;
last if $ i >= 20 ;
}
}
$ text = "$i factoids last referenced by $user: $text" if $ i > 0 ;
return $ text ;
}
}
sub count {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
my $ i = 0 ;
my $ total = 0 ;
if ( not defined $ arguments ) {
return "/msg $nick Usage: count <nick|factoids>" ;
}
$ arguments = ".*" if ( $ arguments =~ /^factoids$/ ) ;
eval {
foreach my $ command ( keys % { $ factoids } ) {
$ total + + if exists $ factoids - > { $ command } { text } ;
my $ regex = qr/^\Q$arguments\E$/ ;
if ( $ factoids - > { $ command } { owner } =~ /$regex/i && exists $ factoids - > { $ command } { text } ) {
$ i + + ;
}
}
} ;
return "/msg $nick $arguments: $@" if $@ ;
return "I have $i factoids" if ( $ arguments eq ".*" ) ;
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 ) = @ _ ;
2010-06-29 06:33:27 +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 ) {
2010-06-29 06:33:27 +02:00
return "/msg $nick Usage: !find [-channel channel] [-owner nick] [-by nick] [text]" ;
2010-03-26 09:58:25 +01:00
}
2010-06-29 06:33:27 +02:00
my ( $ channel , $ owner , $ by ) ;
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 ;
$ by = $ 1 if $ arguments =~ s/-by\s+([^\b\s]+)//i ;
$ owner = '.*' if not defined $ owner ;
$ by = '.*' if not defined $ by ;
$ arguments =~ s/^\s+// ;
$ arguments =~ s/\s+$// ;
$ arguments =~ s/\s+/ /g ;
my $ argtype = undef ;
if ( $ owner ne '.*' ) {
$ argtype = "owned by $owner" ;
}
if ( $ by ne '.*' ) {
if ( not defined $ argtype ) {
$ argtype = "last referenced by $by" ;
} else {
$ argtype . = " and last referenced by $by" ;
}
}
if ( $ arguments ne "" ) {
if ( not defined $ argtype ) {
$ argtype = "with text matching '$arguments'" ;
} else {
$ argtype . = " and with text matching '$arguments'" ;
}
}
if ( not defined $ argtype ) {
2010-06-29 06:33:27 +02:00
return "/msg $nick Usage: !find [-channel] [-owner nick] [-by nick] [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 ;
foreach my $ trigger ( sort keys % { $ factoids - > { $ chan } } ) {
if ( $ factoids - > { $ chan } - > { $ trigger } - > { type } eq 'text' or $ factoids - > { $ chan } - > { $ trigger } - > { type } eq 'regex' ) {
if ( $ factoids - > { $ chan } - > { $ trigger } - > { owner } =~ /$owner/i && $ factoids - > { $ chan } - > { $ trigger } - > { ref_user } =~ /$by/i ) {
next if ( $ arguments ne "" && $ factoids - > { $ chan } - > { $ trigger } - > { action } !~ /$arguments/i && $ trigger !~ /$arguments/i ) ;
$ 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 ;
2010-06-29 08:12:52 +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 {
2010-03-26 09:58:25 +01:00
return "$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 ) = @ _ ;
2010-06-20 08:16:48 +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
}
2010-06-27 04:52:06 +02:00
( $ channel , $ trigger ) = $ self - > { pbot } - > factoids - > find_factoid ( $ channel , $ keyword , undef , 0 , 1 ) ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
if ( not defined $ trigger ) {
return "/msg $nick $keyword not found in channel $from." ;
}
2010-03-22 08:33:44 +01:00
my $ ret = eval {
2010-06-20 08:16:48 +02:00
if ( not $ factoids - > { $ channel } - > { $ trigger } - > { action } =~ s | $ tochange | $ changeto | ) {
$ self - > { pbot } - > logger - > log ( "($from) $nick!$user\@$host: failed to change '$trigger' 's$delim$tochange$delim$changeto$delim\n" ) ;
return "/msg $nick Change $trigger failed." ;
2010-03-22 08:33:44 +01:00
} else {
2010-06-20 08:16:48 +02:00
$ self - > { pbot } - > logger - > log ( "($from) $nick!$user\@$host: changed '$trigger' 's/$tochange/$changeto/\n" ) ;
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > factoids - > save_factoids ( ) ;
2010-06-20 08:16:48 +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 ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
my ( $ keyword , $ module ) = $ arguments =~ /^(.*?)\s+(.*)$/ if defined $ arguments ;
2010-03-28 13:19:54 +02:00
if ( not defined $ module ) {
2010-03-22 08:33:44 +01:00
return "/msg $nick Usage: load <command> <module>" ;
}
if ( not exists ( $ factoids - > { $ keyword } ) ) {
$ factoids - > { $ keyword } { module } = $ module ;
$ factoids - > { $ keyword } { enabled } = 1 ;
$ factoids - > { $ keyword } { owner } = $ nick ;
2010-05-09 01:36:56 +02:00
$ factoids - > { $ keyword } { created_on } = time ( ) ;
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host loaded $keyword => $module\n" ) ;
$ self - > { pbot } - > factoids - > save_factoids ( ) ;
return "/msg $nick Loaded $keyword => $module" ;
} else {
return "/msg $nick There is already a command named $keyword." ;
}
}
sub unload_module {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
if ( not defined $ arguments ) {
return "/msg $nick Usage: unload <module>" ;
} elsif ( not exists $ factoids - > { $ arguments } ) {
return "/msg $nick $arguments not found." ;
} elsif ( not exists $ factoids - > { $ arguments } { module } ) {
return "/msg $nick $arguments is not a module." ;
} else {
delete $ factoids - > { $ arguments } ;
$ self - > { pbot } - > factoids - > save_factoids ( ) ;
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host unloaded module $arguments\n" ) ;
return "/msg $nick $arguments unloaded." ;
}
}
sub enable_command {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
if ( not defined $ arguments ) {
return "/msg $nick Usage: enable <command>" ;
} elsif ( not exists $ factoids - > { $ arguments } ) {
return "/msg $nick $arguments not found." ;
} else {
$ factoids - > { $ arguments } { enabled } = 1 ;
$ self - > { pbot } - > factoids - > save_factoids ( ) ;
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host enabled $arguments\n" ) ;
return "/msg $nick $arguments enabled." ;
}
}
sub disable_command {
my $ self = shift ;
my ( $ from , $ nick , $ user , $ host , $ arguments ) = @ _ ;
my $ factoids = $ self - > { pbot } - > factoids - > factoids ;
if ( not defined $ arguments ) {
return "/msg $nick Usage: disable <command>" ;
} elsif ( not exists $ factoids - > { $ arguments } ) {
return "/msg $nick $arguments not found." ;
} else {
$ factoids - > { $ arguments } { enabled } = 0 ;
$ self - > { pbot } - > factoids - > save_factoids ( ) ;
$ self - > { pbot } - > logger - > log ( "$nick!$user\@$host disabled $arguments\n" ) ;
return "/msg $nick $arguments disabled." ;
}
}
1 ;