2010-03-22 08:33:44 +01:00
# File: Factoids.pm
2010-03-24 07:47:40 +01:00
# Author: pragma_
2010-03-22 08:33:44 +01:00
#
# Purpose: Provides functionality for factoids and a type of external module execution.
package PBot::Factoids ;
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 HTML::Entities ;
use Time::HiRes qw( gettimeofday ) ;
use Carp ( ) ;
use PBot::FactoidModuleLauncher ;
2010-06-20 08:16:48 +02:00
use PBot::DualIndexHashObject ;
2010-03-22 08:33:44 +01:00
sub new {
if ( ref ( $ _ [ 1 ] ) eq 'HASH' ) {
Carp:: croak ( "Options to Factoids should be key/value pairs, not hash reference" ) ;
}
my ( $ class , % conf ) = @ _ ;
my $ self = bless { } , $ class ;
$ self - > initialize ( % conf ) ;
return $ self ;
}
sub initialize {
my ( $ self , % conf ) = @ _ ;
my $ filename = delete $ conf { filename } ;
my $ export_path = delete $ conf { export_path } ;
my $ export_site = delete $ conf { export_site } ;
2011-01-29 02:21:17 +01:00
my $ pbot = delete $ conf { pbot } || Carp:: croak ( "Missing pbot reference to Factoids" ) ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
$ self - > { factoids } = PBot::DualIndexHashObject - > new ( name = > 'Factoids' , filename = > $ filename ) ;
2010-03-22 08:33:44 +01:00
$ self - > { export_path } = $ export_path ;
$ self - > { export_site } = $ export_site ;
$ self - > { pbot } = $ pbot ;
$ self - > { factoidmodulelauncher } = PBot::FactoidModuleLauncher - > new ( pbot = > $ pbot ) ;
}
sub load_factoids {
my $ self = shift ;
2010-06-20 08:16:48 +02:00
$ self - > { pbot } - > logger - > log ( "Loading factoids from " . $ self - > factoids - > filename . " ...\n" ) ;
2010-05-09 01:36:56 +02:00
2010-06-20 08:16:48 +02:00
$ self - > factoids - > load ;
2010-03-22 08:33:44 +01:00
2010-06-20 08:16:48 +02:00
my ( $ text , $ regex , $ modules ) ;
2010-05-09 01:36:56 +02:00
2010-06-20 08:16:48 +02:00
foreach my $ channel ( keys % { $ self - > factoids - > hash } ) {
foreach my $ trigger ( keys % { $ self - > factoids - > hash - > { $ channel } } ) {
$ text + + if $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'text' ;
$ regex + + if $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'regex' ;
$ modules + + if $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'module' ;
2010-03-22 08:33:44 +01:00
}
}
2010-05-09 01:36:56 +02:00
$ self - > { pbot } - > logger - > log ( " " . ( $ text + $ regex + $ modules ) . " factoids loaded ($text text, $regex regexs, $modules modules).\n" ) ;
2010-03-22 08:33:44 +01:00
$ self - > { pbot } - > logger - > log ( "Done.\n" ) ;
}
sub save_factoids {
my $ self = shift ;
2010-06-20 08:16:48 +02:00
$ self - > factoids - > save ;
$ self - > export_factoids ;
}
2010-05-09 01:36:56 +02:00
2010-06-20 08:16:48 +02:00
sub add_factoid {
my $ self = shift ;
my ( $ type , $ channel , $ owner , $ trigger , $ action ) = @ _ ;
2010-05-09 01:36:56 +02:00
2010-06-20 08:16:48 +02:00
$ type = lc $ type ;
$ channel = lc $ channel ;
2010-05-09 01:36:56 +02:00
2010-06-20 08:16:48 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { enabled } = 1 ;
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { type } = $ type ;
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { action } = $ action ;
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { owner } = $ owner ;
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { created_on } = gettimeofday ;
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { ref_count } = 0 ;
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { ref_user } = "nobody" ;
2010-06-21 17:23:46 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { rate_limit } = 15 ;
2010-03-23 19:24:02 +01:00
2010-06-20 08:16:48 +02:00
$ self - > save_factoids ;
2010-03-22 08:33:44 +01:00
}
2010-06-20 08:16:48 +02:00
sub remove_factoid {
2010-03-22 08:33:44 +01:00
my $ self = shift ;
2010-06-20 08:16:48 +02:00
my ( $ channel , $ trigger ) = @ _ ;
2010-03-22 08:33:44 +01:00
$ channel = lc $ channel ;
2010-06-20 08:16:48 +02:00
delete $ self - > factoids - > hash - > { $ channel } - > { $ trigger } ;
$ self - > save_factoids ;
2010-03-22 08:33:44 +01:00
}
sub export_factoids {
my $ self = shift ;
my $ filename ;
if ( @ _ ) { $ filename = shift ; } else { $ filename = $ self - > export_path ; }
return if not defined $ filename ;
open FILE , "> $filename" or return "Could not open export path." ;
2010-06-20 08:16:48 +02:00
2010-03-22 08:33:44 +01:00
my $ time = localtime ;
2010-06-29 08:12:52 +02:00
print FILE "<html><body><i>Last updated at $time</i>\n" ;
2010-06-29 09:14:26 +02:00
print FILE "<hr><h2>Candide's factoids</h2>\n" ;
2010-06-20 08:16:48 +02:00
2010-03-22 08:33:44 +01:00
my $ i = 0 ;
2010-06-20 08:16:48 +02:00
foreach my $ channel ( sort keys % { $ self - > factoids - > hash } ) {
2010-06-29 08:12:52 +02:00
my $ chan = $ channel eq '.*' ? 'Global channel' : "Channel $channel" ;
2010-06-29 09:14:26 +02:00
print FILE "<hr>\n<h3>$chan<h3>\n<hr>\n" ;
2010-06-20 08:16:48 +02:00
print FILE "<table border=\"0\">\n" ;
foreach my $ trigger ( sort keys % { $ self - > factoids - > hash - > { $ channel } } ) {
if ( $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'text' ) {
$ i + + ;
if ( $ i % 2 ) {
print FILE "<tr bgcolor=\"#dddddd\">\n" ;
} else {
print FILE "<tr>\n" ;
}
2010-07-01 03:43:49 +02:00
my $ action = $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { action } ;
2010-07-01 07:54:04 +02:00
$ action =~ s/(.*?)http(s?:\/\/[^ ]+)/encode_entities($1) . "<a href='http" . encode_entities($2) . "'>http" . encode_entities($2) . "<\/a>"/ge ;
2010-07-01 03:43:49 +02:00
$ action =~ s/(.*)<\/a>(.*$)/"$1<\/a>" . encode_entities($2)/e ;
2010-06-20 08:16:48 +02:00
2010-07-01 03:43:49 +02:00
print FILE "<td width=100%><b>$trigger</b> is " . $ action . "</td>\n" ;
2010-06-20 08:16:48 +02:00
2010-06-29 08:50:49 +02:00
print FILE "<td align=\"right\" nowrap>- submitted by " . $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { owner } . "<br><i>" . localtime ( $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { created_on } ) . "</i>\n</td>\n</tr>\n" ;
2010-03-22 08:33:44 +01:00
}
}
2010-06-20 08:16:48 +02:00
print FILE "</table>\n" ;
2010-03-22 08:33:44 +01:00
}
2010-06-20 08:16:48 +02:00
2010-03-22 08:33:44 +01:00
print FILE "<hr>$i factoids memorized.<br>" ;
2010-06-29 08:12:52 +02:00
print FILE "<hr><i>Last updated at $time</i>\n" ;
2010-06-20 08:16:48 +02:00
2010-03-22 08:33:44 +01:00
close ( FILE ) ;
2010-06-20 08:16:48 +02:00
2010-03-23 19:24:02 +01:00
#$self->{pbot}->logger->log("$i factoids exported to path: " . $self->export_path . ", site: " . $self->export_site . "\n");
2010-03-22 08:33:44 +01:00
return "$i factoids exported to " . $ self - > export_site ;
}
2010-04-02 19:33:18 +02:00
sub find_factoid {
2010-06-27 04:52:06 +02:00
my ( $ self , $ from , $ keyword , $ arguments , $ exact_channel , $ exact_trigger ) = @ _ ;
2010-06-20 08:16:48 +02:00
2012-07-22 21:22:30 +02:00
my $ debug = 0 ;
$ self - > { pbot } - > logger - > log ( "find_factoid: from: [$from], kw: [$keyword], args: [" . ( defined $ arguments ? $ arguments : "undef" ) . "], " . ( defined $ exact_channel ? $ exact_channel : "undef" ) . ", " . ( defined $ exact_trigger ? $ exact_trigger : "undef" ) . "\n" ) if $ debug ;
2010-06-30 06:58:22 +02:00
$ from = '.*' if not defined $ from or $ from !~ /^#/ ;
2010-04-02 19:33:18 +02:00
2012-07-22 21:22:30 +02:00
$ self - > { pbot } - > logger - > log ( "from: $from\n" ) if $ debug ;
2010-04-02 19:33:18 +02:00
my $ string = "$keyword" . ( defined $ arguments ? " $arguments" : "" ) ;
2012-07-22 21:22:30 +02:00
$ self - > { pbot } - > logger - > log ( "string: $string\n" ) if $ debug ;
2010-06-20 08:16:48 +02:00
my @ result = eval {
foreach my $ channel ( sort keys % { $ self - > factoids - > hash } ) {
2011-02-14 09:09:50 +01:00
if ( $ exact_channel ) {
2012-07-22 21:22:30 +02:00
next unless lc $ from eq lc $ channel or $ from eq '.*' or $ channel eq '.*' ;
2011-02-14 09:09:50 +01:00
}
2010-06-30 05:48:13 +02:00
2010-06-20 08:16:48 +02:00
foreach my $ trigger ( keys % { $ self - > factoids - > hash - > { $ channel } } ) {
2010-06-27 04:52:06 +02:00
if ( not $ exact_trigger and $ self - > factoids - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'regex' ) {
2010-06-20 08:16:48 +02:00
if ( $ string =~ m/$trigger/i ) {
2012-07-22 21:22:30 +02:00
$ self - > { pbot } - > logger - > log ( "return regex $channel: $trigger\n" ) if $ debug ;
2010-06-20 08:16:48 +02:00
return ( $ channel , $ trigger ) ;
}
} else {
if ( $ keyword =~ m/^\Q$trigger\E$/i ) {
2012-07-22 21:22:30 +02:00
$ self - > { pbot } - > logger - > log ( "return $channel: $trigger\n" ) if $ debug ;
2010-06-20 08:16:48 +02:00
return ( $ channel , $ trigger ) ;
}
2010-04-02 19:33:18 +02:00
}
}
}
2012-07-22 21:22:30 +02:00
$ self - > { pbot } - > logger - > log ( "find_factoid: no match\n" ) if $ debug ;
2010-04-02 19:33:18 +02:00
return undef ;
} ;
if ( $@ ) {
$ self - > { pbot } - > logger - > log ( "find_factoid: bad regex: $@\n" ) ;
return undef ;
}
2010-06-20 08:16:48 +02:00
return @ result ;
2010-04-10 00:55:24 +02:00
}
2010-03-22 08:33:44 +01:00
sub interpreter {
my $ self = shift ;
2011-01-29 02:21:17 +01:00
my ( $ from , $ nick , $ user , $ host , $ count , $ keyword , $ arguments , $ tonick , $ ref_from ) = @ _ ;
2010-06-20 08:16:48 +02:00
my ( $ result , $ channel ) ;
2010-03-22 08:33:44 +01:00
my $ pbot = $ self - > { pbot } ;
2010-06-30 13:36:45 +02:00
return undef if not length $ keyword ;
2011-01-29 02:21:17 +01:00
$ from = lc $ from ;
2012-07-22 21:22:30 +02:00
#$self->{pbot}->logger->log("factoids interpreter: from: [$from], ref_from: [" . (defined $ref_from ? $ref_from : "undef") . "]\n");
2011-01-30 07:29:05 +01:00
# search for factoid against global channel and current channel (from unless ref_from is defined)
2010-06-20 08:16:48 +02:00
my $ original_keyword = $ keyword ;
2012-07-22 21:22:30 +02:00
#$self->{pbot}->logger->log("calling find_factoid in Factoids.pm, interpreter() to search for factoid against global/current\n");
( $ channel , $ keyword ) = $ self - > find_factoid ( $ ref_from ? $ ref_from : $ from , $ keyword , $ arguments , 1 ) ;
2011-01-30 07:29:05 +01:00
2012-07-22 21:22:30 +02:00
if ( not defined $ ref_from or $ ref_from eq '.*' ) {
2011-01-30 07:29:05 +01:00
$ ref_from = "" ;
} else {
2012-07-22 21:22:30 +02:00
$ ref_from = "[$ref_from] " ;
}
if ( defined $ channel and not $ channel eq '.*' and not lc $ channel eq $ from ) {
$ ref_from = "[$channel] " ;
2011-01-30 07:29:05 +01:00
}
$ arguments = "" if not defined $ arguments ;
2010-06-20 08:16:48 +02:00
2011-01-30 04:55:09 +01:00
# if no match found, attempt to call factoid from another channel if it exists there
2010-06-20 08:16:48 +02:00
if ( not defined $ keyword ) {
2011-01-29 02:21:17 +01:00
my $ chans = "" ;
my $ comma = "" ;
my $ found = 0 ;
my ( $ fwd_chan , $ fwd_trig ) ;
2011-01-30 04:55:09 +01:00
# build string of which channels contain the keyword, keeping track of the last one and count
foreach my $ chan ( keys % { $ self - > factoids - > hash } ) {
2011-01-29 02:21:17 +01:00
foreach my $ trig ( keys % { $ self - > factoids - > hash - > { $ chan } } ) {
if ( lc $ trig eq lc $ original_keyword ) {
$ chans . = $ comma . $ chan ;
$ comma = ", " ;
$ found + + ;
$ fwd_chan = $ chan ;
$ fwd_trig = $ trig ;
last ;
}
}
}
2011-01-30 04:55:09 +01:00
# if multiple channels have this keyword, then ask user to disambiguate
2011-01-29 02:21:17 +01:00
if ( $ found > 1 ) {
2011-01-30 04:06:45 +01:00
return $ ref_from . "Ambiguous keyword '$original_keyword' exists in multiple locations (use 'fact <location> <keyword>' to choose one): $chans" ;
2011-01-29 02:21:17 +01:00
}
2011-01-30 04:55:09 +01:00
# if there's just one other channel that has this keyword, trigger that instance
2011-01-29 02:21:17 +01:00
elsif ( $ found == 1 ) {
$ pbot - > logger - > log ( "Found '$original_keyword' as '$fwd_trig' in [$fwd_chan]\n" ) ;
2011-01-30 08:18:28 +01:00
return $ pbot - > factoids - > interpreter ( $ from , $ nick , $ user , $ host , $ count , $ fwd_trig , $ arguments , undef , $ fwd_chan ) ;
2011-01-30 04:55:09 +01:00
}
# otherwise keyword hasn't been found, display similiar matches for all channels
else {
2011-01-30 03:44:56 +01:00
# if a non-nick argument was supplied, e.g., a sentence using the bot's nick, don't say anything
2011-01-30 07:29:05 +01:00
return "" if length $ arguments and $ arguments !~ /^[^.+-, ]{1,20}$/ ;
2011-01-30 04:55:09 +01:00
# find matches from all channels
2011-01-29 02:21:17 +01:00
my $ matches = $ self - > factoids - > levenshtein_matches ( '.*' , lc $ original_keyword ) ;
2010-03-24 07:47:40 +01:00
2011-01-29 02:21:17 +01:00
# don't say anything if nothing similiar was found
return undef if $ matches eq 'none' ;
2010-06-20 08:16:48 +02:00
2011-01-29 02:21:17 +01:00
return $ ref_from . "No such factoid '$original_keyword'; did you mean $matches?" ;
}
2010-06-20 08:16:48 +02:00
}
my $ type = $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { type } ;
2010-03-24 07:47:40 +01:00
2010-04-02 19:33:18 +02:00
# Check if it's an alias
2010-06-20 08:16:48 +02:00
if ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } =~ /^\/call\s+(.*)$/ ) {
my $ command ;
2011-01-30 08:18:28 +01:00
if ( length $ arguments ) {
2010-04-02 19:33:18 +02:00
$ command = "$1 $arguments" ;
} else {
$ command = $ 1 ;
2010-03-24 07:47:40 +01:00
}
2010-06-20 08:16:48 +02:00
2011-01-25 23:40:22 +01:00
$ pbot - > logger - > log ( "[" . ( defined $ from ? $ from : "stdin" ) . "] ($nick!$user\@$host) [$keyword] aliased to: [$command]\n" ) ;
2010-04-02 19:33:18 +02:00
2010-06-20 08:16:48 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { ref_count } + + ;
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { ref_user } = $ nick ;
2010-06-21 12:44:15 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } = gettimeofday ;
2010-04-02 19:33:18 +02:00
2011-01-30 08:18:28 +01:00
return $ pbot - > interpreter - > interpret ( $ from , $ nick , $ user , $ host , $ count , $ command ) ;
2010-03-24 07:47:40 +01:00
}
2010-08-14 11:45:58 +02:00
my $ last_ref_in = 0 ;
2010-06-21 17:23:46 +02:00
if ( exists $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } ) {
2010-08-14 11:45:58 +02:00
if ( exists $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } ) {
if ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } eq $ from ) {
$ last_ref_in = 1 ;
}
}
if ( ( $ last_ref_in == 1 ) and ( gettimeofday - $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } < $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { rate_limit } ) ) {
2011-01-29 02:21:17 +01:00
return "/msg $nick $ref_from'$keyword' is rate-limited; try again in " . ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { rate_limit } - int ( gettimeofday - $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } ) ) . " seconds." ;
2010-06-21 17:23:46 +02:00
}
}
2010-06-20 08:16:48 +02:00
if ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { enabled } == 0 ) {
2010-04-02 19:33:18 +02:00
$ self - > { pbot } - > logger - > log ( "$keyword disabled.\n" ) ;
2011-01-29 02:21:17 +01:00
return "/msg $nick $ref_from$keyword is currently disabled." ;
2010-06-21 17:23:46 +02:00
}
elsif ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'module' ) {
2010-04-02 19:33:18 +02:00
$ self - > { pbot } - > logger - > log ( "Found module\n" ) ;
2010-06-20 08:16:48 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { ref_count } + + ;
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { ref_user } = $ nick ;
2010-06-21 12:44:15 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } = gettimeofday ;
2011-01-25 00:46:07 +01:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } = $ from || "stdin" ;
2010-04-02 19:33:18 +02:00
2011-01-29 02:21:17 +01:00
return $ ref_from . $ self - > { factoidmodulelauncher } - > execute_module ( $ from , $ tonick , $ nick , $ user , $ host , $ keyword , $ arguments ) ;
2010-04-02 19:33:18 +02:00
}
2010-06-20 08:16:48 +02:00
elsif ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'text' ) {
2010-04-02 19:33:18 +02:00
$ self - > { pbot } - > logger - > log ( "Found factoid\n" ) ;
# Don't allow user-custom /msg factoids, unless factoid triggered by admin
2010-06-20 08:16:48 +02:00
if ( ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } =~ m/^\/msg/i ) and ( not $ self - > { pbot } - > admins - > loggedin ( $ from , "$nick!$user\@$host" ) ) ) {
2011-01-25 23:40:22 +01:00
$ self - > { pbot } - > logger - > log ( "[ABUSE] Bad factoid (contains /msg): " . $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } . "\n" ) ;
2010-04-02 19:33:18 +02:00
return "You must login to use this command."
}
2010-06-20 08:16:48 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { ref_count } + + ;
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { ref_user } = $ nick ;
2010-06-21 12:44:15 +02:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } = gettimeofday ;
2011-01-25 00:46:07 +01:00
$ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } = $ from || "stdin" ;
2010-04-02 19:33:18 +02:00
if ( defined $ tonick ) { # !tell foo about bar
$ self - > { pbot } - > logger - > log ( "($from): $nick!$user\@$host) sent to $tonick\n" ) ;
my $ fromnick = $ self - > { pbot } - > admins - > loggedin ( $ from , "$nick!$user\@$host" ) ? "" : "$nick wants you to know: " ;
2010-06-20 08:16:48 +02:00
$ result = $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } ;
2010-04-02 19:33:18 +02:00
my $ botnick = $ self - > { pbot } - > botnick ;
if ( $ result =~ s/^\/say\s+//i || $ result =~ s/^\/me\s+/* $botnick /i
|| $ result =~ /^\/msg\s+/i ) {
$ result = "/msg $tonick $fromnick$result" ;
} else {
$ result = "/msg $tonick $fromnick$keyword is $result" ;
2010-03-22 08:33:44 +01:00
}
2011-01-25 23:40:22 +01:00
$ self - > { pbot } - > logger - > log ( "result set to [$result]\n" ) ;
2010-04-02 19:33:18 +02:00
} else {
2010-06-20 08:16:48 +02:00
$ result = $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } ;
2010-04-02 19:33:18 +02:00
}
2010-03-22 08:33:44 +01:00
2011-01-30 08:18:28 +01:00
if ( length $ arguments ) {
2011-01-25 23:40:22 +01:00
if ( exists $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action_with_args } ) {
$ result = $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action_with_args } ;
}
2011-12-17 01:30:44 +01:00
if ( not $ result =~ s/\$args/$arguments/gi and not exists $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action_with_args } ) {
2011-01-25 23:40:22 +01:00
# factoid doesn't take an argument, so assume argument is a nick if it is a single-word 20 characters or less
# TODO - maintain list of channel nicks and compare against this list to ensure nick exists
2011-01-30 03:44:56 +01:00
if ( $ arguments =~ /^[^.+-, ]{1,20}$/ ) {
2010-04-02 19:33:18 +02:00
# might be a nick
if ( $ result =~ /^\/.+? / ) {
$ result =~ s/^(\/.+?) /$1 $arguments: / ;
2010-03-22 08:33:44 +01:00
} else {
2011-01-25 23:40:22 +01:00
$ result =~ s/^/\/say $arguments: $keyword is / unless defined $ tonick ;
2010-04-02 19:33:18 +02:00
}
2010-03-22 08:33:44 +01:00
} else {
2011-01-30 03:44:56 +01:00
# return "";
2010-03-22 08:33:44 +01:00
}
}
2010-04-02 19:33:18 +02:00
} else {
# no arguments supplied
$ result =~ s/\$args/$nick/gi ;
}
2010-03-22 08:33:44 +01:00
2011-02-14 09:09:50 +01:00
$ self - > { pbot } - > logger - > log ( "(" . ( defined $ from ? $ from : "(undef)" ) . "): $nick!$user\@$host): $keyword: Displaying text \"" . $ result . "\"\n" ) ;
2011-02-14 08:25:15 +01:00
2010-04-02 19:33:18 +02:00
$ result =~ s/\$nick/$nick/g ;
2010-06-30 13:36:45 +02:00
while ( $ result =~ /[^\\]\$([a-zA-Z0-9_\-]+)/g ) {
2012-07-22 21:22:30 +02:00
#$self->{pbot}->logger->log("adlib: looking for [$1]\n");
#$self->{pbot}->logger->log("calling find_factoid in Factoids.pm, interpreter() to look for adlib");
2010-06-27 04:52:06 +02:00
my ( $ var_chan , $ var ) = $ self - > find_factoid ( $ from , $ 1 , undef , 0 , 1 ) ;
2010-06-20 08:16:48 +02:00
if ( defined $ var && $ self - > factoids - > hash - > { $ var_chan } - > { $ var } - > { type } eq 'text' ) {
my $ change = $ self - > factoids - > hash - > { $ var_chan } - > { $ var } - > { action } ;
2010-04-02 19:33:18 +02:00
my @ list = split ( /\s|(".*?")/ , $ change ) ;
my @ mylist ;
#$self->{pbot}->logger->log("adlib: list [". join(':', @mylist) ."]\n");
for ( my $ i = 0 ; $ i <= $# list ; $ i + + ) {
#$self->{pbot}->logger->log("adlib: pushing $i $list[$i]\n");
push @ mylist , $ list [ $ i ] if $ list [ $ i ] ;
2010-03-22 08:33:44 +01:00
}
2010-04-02 19:33:18 +02:00
my $ line = int ( rand ( $# mylist + 1 ) ) ;
$ mylist [ $ line ] =~ s/"//g ;
$ result =~ s/\$$var/$mylist[$line]/ ;
#$self->{pbot}->logger->log("adlib: found: change: $result\n");
} else {
$ result =~ s/\$$var/$var/g ;
#$self->{pbot}->logger->log("adlib: not found: change: $result\n");
2010-03-22 08:33:44 +01:00
}
}
2010-04-02 19:33:18 +02:00
$ result =~ s/\\\$/\$/g ;
2011-01-30 08:18:28 +01:00
if ( $ result =~ s/^\/say\s+/$ref_from/i || $ result =~ s/^\/me\s+(.*)/\/me $1 $ref_from/i
|| $ result =~ s/^\/msg\s+([^ ]+)/\/msg $1 $ref_from/i ) {
return $ result ;
2010-04-02 19:33:18 +02:00
} else {
2011-01-29 02:21:17 +01:00
return $ ref_from . "$keyword is $result" ;
2010-04-02 19:33:18 +02:00
}
2010-06-20 08:16:48 +02:00
} elsif ( $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'regex' ) {
2010-04-02 19:33:18 +02:00
$ result = eval {
2010-06-30 05:48:13 +02:00
my $ string = "$original_keyword" . ( defined $ arguments ? " $arguments" : "" ) ;
my $ cmd ;
2010-04-02 19:33:18 +02:00
if ( $ string =~ m/$keyword/i ) {
2010-06-20 08:16:48 +02:00
$ self - > { pbot } - > logger - > log ( "[$string] matches [$keyword] - calling [" . $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } . "$']\n" ) ;
2010-06-30 05:48:13 +02:00
$ cmd = $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } . $' ;
2010-06-20 08:16:48 +02:00
my ( $ a , $ b , $ c , $ d , $ e , $ f , $ g , $ h , $ i , $ before , $ after ) = ( $ 1 , $ 2 , $ 3 , $ 4 , $ 5 , $ 6 , $ 7 , $ 8 , $ 9 , $` , $' ) ;
2010-04-02 19:33:18 +02:00
$ cmd =~ s/\$1/$a/g ;
$ cmd =~ s/\$2/$b/g ;
$ cmd =~ s/\$3/$c/g ;
$ cmd =~ s/\$4/$d/g ;
$ cmd =~ s/\$5/$e/g ;
$ cmd =~ s/\$6/$f/g ;
$ cmd =~ s/\$7/$g/g ;
$ cmd =~ s/\$8/$h/g ;
$ cmd =~ s/\$9/$i/g ;
$ cmd =~ s/\$`/$before/g ;
$ cmd =~ s/\$'/$after/g ;
$ cmd =~ s/^\s+// ;
$ cmd =~ s/\s+$// ;
2010-06-30 05:48:13 +02:00
} else {
$ cmd = $ self - > factoids - > hash - > { $ channel } - > { $ keyword } - > { action } ;
2010-04-02 19:33:18 +02:00
}
2010-06-30 05:48:13 +02:00
2011-01-30 04:03:31 +01:00
$ result = $ pbot - > interpreter - > interpret ( $ from , $ nick , $ user , $ host , $ count , $ cmd ) ;
2011-01-30 08:18:28 +01:00
return $ result ;
2010-04-02 19:33:18 +02:00
} ;
2010-06-30 05:48:13 +02:00
2010-04-02 19:33:18 +02:00
if ( $@ ) {
$ self - > { pbot } - > logger - > log ( "Regex fail: $@\n" ) ;
2011-01-29 02:21:17 +01:00
return "/msg $nick $ref_from" . "Fail." ;
2010-04-02 19:33:18 +02:00
}
2011-01-29 02:21:17 +01:00
return $ ref_from . $ result ;
2010-04-02 19:33:18 +02:00
} else {
$ self - > { pbot } - > logger - > log ( "($from): $nick!$user\@$host): Unknown command type for '$keyword'\n" ) ;
2011-01-29 02:21:17 +01:00
return "/me blinks." . " $ref_from" ;
2010-03-22 08:33:44 +01:00
}
2011-01-29 02:21:17 +01:00
# should never be reached; if it has, something has gone horribly wrong.
# (advanced notification of corruption or a waste of space?)
return "/me wrinkles her nose." . " $ref_from" ;
2010-03-22 08:33:44 +01:00
}
sub export_path {
my $ self = shift ;
if ( @ _ ) { $ self - > { export_path } = shift ; }
return $ self - > { export_path } ;
}
sub logger {
my $ self = shift ;
if ( @ _ ) { $ self - > { logger } = shift ; }
return $ self - > { logger } ;
}
sub export_site {
my $ self = shift ;
if ( @ _ ) { $ self - > { export_site } = shift ; }
return $ self - > { export_site } ;
}
sub factoids {
my $ self = shift ;
return $ self - > { factoids } ;
}
sub filename {
my $ self = shift ;
if ( @ _ ) { $ self - > { filename } = shift ; }
return $ self - > { filename } ;
}
1 ;
