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.
2017-03-05 22:33:31 +01:00
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
2010-03-22 08:33:44 +01:00
package PBot::Factoids ;
use warnings ;
use strict ;
2015-09-14 19:22:55 +02:00
use feature 'switch' ;
no if $] >= 5.018 , warnings = > "experimental::smartmatch" ;
2010-03-22 08:33:44 +01:00
use HTML::Entities ;
use Time::HiRes qw( gettimeofday ) ;
2017-08-05 06:05:31 +02:00
use Time::Duration qw( duration ) ;
2010-03-22 08:33:44 +01:00
use Carp ( ) ;
2013-10-12 15:35:57 +02:00
use POSIX qw( strftime ) ;
2015-06-26 07:56:10 +02:00
use Text::ParseWords ;
2017-09-12 14:50:49 +02:00
use JSON ;
2010-03-22 08:33:44 +01:00
2017-08-26 00:32:28 +02:00
use PPI ;
2017-08-24 04:25:43 +02:00
use Safe ;
2014-05-17 22:08:19 +02:00
use PBot::PBot qw( $VERSION ) ;
2014-05-18 02:27:57 +02:00
use PBot::FactoidCommands ;
2010-03-22 08:33:44 +01:00
use PBot::FactoidModuleLauncher ;
2010-06-20 08:16:48 +02:00
use PBot::DualIndexHashObject ;
2010-03-22 08:33:44 +01:00
2017-08-26 08:36:11 +02:00
use PBot::Utils::Indefinite ;
2017-09-05 09:27:28 +02:00
use PBot::Utils::ValidateString ;
2017-08-26 08:36:11 +02:00
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 ) = @ _ ;
2014-05-18 02:27:57 +02:00
my $ filename = delete $ conf { filename } ;
2010-03-22 08:33:44 +01:00
my $ export_path = delete $ conf { export_path } ;
my $ export_site = delete $ conf { export_site } ;
2014-03-03 11:33:34 +01:00
my $ pbot = delete $ conf { pbot } // Carp:: croak ( "Missing pbot reference to Factoids" ) ;
2010-03-22 08:33:44 +01:00
2014-05-18 02:27:57 +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 ;
2014-05-18 02:27:57 +02:00
$ self - > { pbot } = $ pbot ;
$ self - > { commands } = PBot::FactoidCommands - > new ( pbot = > $ pbot ) ;
2010-03-22 08:33:44 +01:00
$ self - > { factoidmodulelauncher } = PBot::FactoidModuleLauncher - > new ( pbot = > $ pbot ) ;
2014-05-17 00:11:31 +02:00
2014-05-24 14:01:59 +02:00
$ self - > { pbot } - > { registry } - > add_default ( 'text' , 'factoids' , 'default_rate_limit' , '15' ) ;
2014-05-17 00:11:31 +02:00
$ self - > { pbot } - > { atexit } - > register ( sub { $ self - > save_factoids ; return ; } ) ;
2014-05-17 22:08:19 +02:00
2017-08-24 04:25:43 +02:00
$ self - > { compartments } = { } ;
2014-05-17 22:08:19 +02:00
$ self - > load_factoids ;
2010-03-22 08:33:44 +01:00
}
sub load_factoids {
my $ self = shift ;
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "Loading factoids from " . $ self - > { factoids } - > filename . " ...\n" ) ;
2010-05-09 01:36:56 +02:00
2014-05-18 22:09:05 +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
2014-05-18 22:09:05 +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
}
}
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( " " . ( $ text + $ regex + $ modules ) . " factoids loaded ($text text, $regex regexs, $modules modules).\n" ) ;
$ self - > { pbot } - > { logger } - > log ( "Done.\n" ) ;
2017-08-06 05:25:26 +02:00
$ self - > add_default_factoids ( ) ;
}
sub add_default_factoids {
my $ self = shift ;
$ self - > add_factoid ( 'text' , '.*' , $ self - > { pbot } - > { registry } - > get_value ( 'irc' , 'botnick' ) , 'version' , "/say $VERSION" , 1 ) ;
2010-03-22 08:33:44 +01:00
}
sub save_factoids {
my $ self = shift ;
2014-05-18 22:09:05 +02:00
$ self - > { factoids } - > save ;
2010-06-20 08:16:48 +02:00
$ 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 ;
2014-05-17 22:08:19 +02:00
my ( $ type , $ channel , $ owner , $ trigger , $ action , $ dont_save ) = @ _ ;
2010-05-09 01:36:56 +02:00
2010-06-20 08:16:48 +02:00
$ type = lc $ type ;
2015-02-16 05:18:46 +01:00
$ channel = '.*' if $ channel !~ /^#/ ;
2010-06-20 08:16:48 +02:00
$ channel = lc $ channel ;
2010-05-09 01:36:56 +02:00
2014-05-18 22:09:05 +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" ;
2014-05-24 14:01:59 +02:00
$ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { rate_limit } = $ self - > { pbot } - > { registry } - > get_value ( 'factoids' , 'default_rate_limit' ) ;
2010-03-23 19:24:02 +01:00
2014-05-17 22:08:19 +02:00
$ self - > save_factoids unless $ dont_save ;
2015-12-13 22:58:01 +01:00
unless ( $ dont_save ) {
$ self - > { commands } - > log_factoid ( $ channel , $ trigger , $ owner , "created: $action" ) ;
}
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
2015-02-16 05:18:46 +01:00
$ channel = '.*' if $ channel !~ /^#/ ;
2010-03-22 08:33:44 +01:00
$ channel = lc $ channel ;
2010-06-20 08:16:48 +02:00
2014-05-18 22:09:05 +02:00
delete $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } ;
2014-05-17 22:08:19 +02:00
2017-04-11 04:55:52 +02:00
if ( not scalar keys % { $ self - > { factoids } - > hash - > { $ channel } } ) {
2014-05-18 22:09:05 +02:00
delete $ self - > { factoids } - > hash - > { $ channel } ;
2014-05-17 22:08:19 +02:00
}
2010-06-20 08:16:48 +02:00
$ 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 ;
2013-10-12 15:35:57 +02:00
print FILE "<html><head>\n<link href='css/blue.css' rel='stylesheet' type='text/css'>\n" ;
print FILE '<script type="text/javascript" src="js/jquery-latest.js"></script>' . "\n" ;
print FILE '<script type="text/javascript" src="js/jquery.tablesorter.js"></script>' . "\n" ;
2014-03-03 10:24:33 +01:00
print FILE '<script type="text/javascript" src="js/picnet.table.filter.min.js"></script>' . "\n" ;
2013-10-12 15:35:57 +02:00
print FILE "</head>\n<body><i>Last updated at $time</i>\n" ;
2013-10-14 19:22:06 +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 ;
2013-10-12 15:35:57 +02:00
my $ table_id = 1 ;
2010-06-20 08:16:48 +02:00
2014-05-18 22:09:05 +02:00
foreach my $ channel ( sort keys % { $ self - > { factoids } - > hash } ) {
next if not scalar keys % { $ self - > { factoids } - > hash - > { $ channel } } ;
2013-10-12 15:52:12 +02:00
my $ chan = $ channel eq '.*' ? 'global' : $ channel ;
2017-11-19 23:37:02 +01:00
print FILE "<a href='#" . encode_entities ( $ chan ) . "'>" . encode_entities ( $ chan ) . "</a><br>\n" ;
2013-10-12 15:52:12 +02:00
}
2014-05-18 22:09:05 +02:00
foreach my $ channel ( sort keys % { $ self - > { factoids } - > hash } ) {
next if not scalar keys % { $ self - > { factoids } - > hash - > { $ channel } } ;
2013-10-12 15:52:12 +02:00
my $ chan = $ channel eq '.*' ? 'global' : $ channel ;
2017-11-19 23:37:02 +01:00
print FILE "<a name='" . encode_entities ( $ chan ) . "'></a>\n" ;
print FILE "<hr>\n<h3>" . encode_entities ( $ chan ) . "</h3>\n<hr>\n" ;
2013-10-12 15:35:57 +02:00
print FILE "<table border=\"0\" id=\"table$table_id\" class=\"tablesorter\">\n" ;
print FILE "<thead>\n<tr>\n" ;
print FILE "<th>owner</th>\n" ;
print FILE "<th>created on</th>\n" ;
print FILE "<th>times referenced</th>\n" ;
print FILE "<th>factoid</th>\n" ;
print FILE "<th>last edited by</th>\n" ;
print FILE "<th>edited date</th>\n" ;
print FILE "<th>last referenced by</th>\n" ;
print FILE "<th>last referenced date</th>\n" ;
print FILE "</tr>\n</thead>\n<tbody>\n" ;
$ table_id + + ;
2014-05-18 22:09:05 +02:00
foreach my $ trigger ( sort keys % { $ self - > { factoids } - > hash - > { $ channel } } ) {
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'text' ) {
2010-06-20 08:16:48 +02:00
$ i + + ;
if ( $ i % 2 ) {
print FILE "<tr bgcolor=\"#dddddd\">\n" ;
} else {
print FILE "<tr>\n" ;
}
2010-07-01 03:43:49 +02:00
2015-10-03 05:06:25 +02:00
print FILE "<td>" . encode_entities ( $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { owner } ) . "</td>\n" ;
2014-05-18 22:09:05 +02:00
print FILE "<td>" . encode_entities ( strftime "%Y/%m/%d %H:%M:%S" , localtime $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { created_on } ) . "</td>\n" ;
2013-10-12 15:35:57 +02:00
2014-05-18 22:09:05 +02:00
print FILE "<td>" . $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { ref_count } . "</td>\n" ;
2013-10-12 15:35:57 +02:00
2014-05-18 22:09:05 +02:00
my $ action = $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { action } ;
2015-10-03 05:14:48 +02:00
if ( $ action =~ m/https?:\/\/[^ ]+/ ) {
$ action =~ s/(.*?)http(s?:\/\/[^ ]+)/encode_entities($1) . "<a href='http" . encode_entities($2) . "'>http" . encode_entities($2) . "<\/a>"/ge ;
$ action =~ s/(.*)<\/a>(.*$)/"$1<\/a>" . encode_entities($2)/e ;
} else {
$ action = encode_entities ( $ action ) ;
}
2014-04-07 06:50:00 +02:00
2014-05-18 22:09:05 +02:00
if ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { action_with_args } ) {
my $ with_args = $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { action_with_args } ;
2014-04-07 06:50:00 +02:00
$ with_args =~ s/(.*?)http(s?:\/\/[^ ]+)/encode_entities($1) . "<a href='http" . encode_entities($2) . "'>http" . encode_entities($2) . "<\/a>"/ge ;
$ with_args =~ s/(.*)<\/a>(.*$)/"$1<\/a>" . encode_entities($2)/e ;
2015-10-03 05:14:48 +02:00
print FILE "<td width=100%><b>" . encode_entities ( $ trigger ) . "</b> is $action<br><br><b>with_args:</b> " . encode_entities ( $ with_args ) . "</td>\n" ;
2014-04-07 06:50:00 +02:00
} else {
2015-10-03 05:14:48 +02:00
print FILE "<td width=100%><b>" . encode_entities ( $ trigger ) . "</b> is $action</td>\n" ;
2014-04-07 06:50:00 +02:00
}
2013-10-12 15:35:57 +02:00
2014-05-18 22:09:05 +02:00
if ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { edited_by } ) {
print FILE "<td>" . $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { edited_by } . "</td>\n" ;
print FILE "<td>" . encode_entities ( strftime "%Y/%m/%d %H:%M:%S" , localtime $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { edited_on } ) . "</td>\n" ;
2013-10-12 15:35:57 +02:00
} else {
print FILE "<td></td>\n" ;
print FILE "<td></td>\n" ;
}
2015-10-03 05:06:25 +02:00
print FILE "<td>" . encode_entities ( $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { ref_user } ) . "</td>\n" ;
2013-10-12 15:35:57 +02:00
2014-05-18 22:09:05 +02:00
if ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { last_referenced_on } ) {
print FILE "<td>" . encode_entities ( strftime "%Y/%m/%d %H:%M:%S" , localtime $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { last_referenced_on } ) . "</td>\n" ;
2013-10-12 15:35:57 +02:00
} else {
print FILE "<td></td>\n" ;
}
print FILE "</tr>\n" ;
2010-03-22 08:33:44 +01:00
}
}
2013-10-12 15:35:57 +02:00
print FILE "</tbody>\n</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" ;
2013-10-12 15:35:57 +02:00
print FILE "<script type='text/javascript'>\n" ;
$ table_id - - ;
print FILE '$(document).ready(function() {' . "\n" ;
while ( $ table_id > 0 ) {
print FILE '$("#table' . $ table_id . '").tablesorter();' . "\n" ;
2014-03-03 10:24:33 +01:00
print FILE '$("#table' . $ table_id . '").tableFilter();' . "\n" ;
2013-10-12 15:35:57 +02:00
$ table_id - - ;
}
print FILE "});\n" ;
print FILE "</script>\n" ;
print FILE "</body>\n</html>\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
2014-05-18 22:09:05 +02:00
#$self->{pbot}->{logger}->log("$i factoids exported to path: " . $self->export_path . ", site: " . $self->export_site . "\n");
2017-09-02 09:14:13 +02:00
return "/say $i factoids exported to " . $ self - > export_site ;
2010-03-22 08:33:44 +01:00
}
2010-04-02 19:33:18 +02:00
sub find_factoid {
2015-03-29 01:49:42 +01:00
my ( $ self , $ from , $ keyword , $ arguments , $ exact_channel , $ exact_trigger , $ find_alias ) = @ _ ;
2010-06-20 08:16:48 +02:00
2012-07-22 21:22:30 +02:00
my $ debug = 0 ;
2014-05-18 22:09:05 +02:00
$ 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 ;
2012-07-22 21:22:30 +02:00
2010-06-30 06:58:22 +02:00
$ from = '.*' if not defined $ from or $ from !~ /^#/ ;
2014-05-23 14:42:23 +02:00
$ from = lc $ from ;
2010-04-02 19:33:18 +02:00
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "from: $from\n" ) if $ debug ;
2012-07-22 21:22:30 +02:00
2010-06-20 08:16:48 +02:00
my @ result = eval {
2015-07-22 00:07:56 +02:00
my @ results ;
2015-03-29 01:49:42 +01:00
for ( my $ depth = 0 ; $ depth < 5 ; $ depth + + ) {
2017-10-10 04:35:11 +02:00
my $ string = $ keyword . ( defined $ arguments ? " $arguments" : "" ) ;
$ self - > { pbot } - > { logger } - > log ( "string: $string\n" ) if $ debug ;
return undef if $ self - > { pbot } - > { commands } - > exists ( $ keyword ) ;
2015-03-29 01:49:42 +01:00
# check factoids
2014-10-28 21:33:11 +01:00
foreach my $ channel ( sort keys % { $ self - > { factoids } - > hash } ) {
if ( $ exact_channel ) {
2015-10-19 21:21:42 +02:00
if ( defined $ exact_trigger && $ exact_trigger == 1 ) {
2015-04-10 23:59:17 +02:00
next unless $ from eq lc $ channel ;
} else {
next unless $ from eq lc $ channel or $ channel eq '.*' ;
}
2014-10-28 21:33:11 +01:00
}
foreach my $ trigger ( keys % { $ self - > { factoids } - > hash - > { $ channel } } ) {
2015-03-29 01:49:42 +01:00
if ( $ keyword =~ m/^\Q$trigger\E$/i ) {
$ self - > { pbot } - > { logger } - > log ( "return $channel: $trigger\n" ) if $ debug ;
if ( $ find_alias && $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { action } =~ /^\/call\s+(.*)$/ ) {
my $ command ;
if ( length $ arguments ) {
$ command = "$1 $arguments" ;
} else {
$ command = $ 1 ;
}
2017-09-02 09:39:29 +02:00
( $ keyword , $ arguments ) = split /\s+/ , $ command , 2 ;
2015-03-29 01:49:42 +01:00
goto NEXT_DEPTH ;
2014-10-28 21:33:11 +01:00
}
2015-03-29 01:49:42 +01:00
2015-10-25 12:01:45 +01:00
if ( defined $ exact_channel && $ exact_channel == 1 ) {
2015-07-22 00:07:56 +02:00
return ( $ channel , $ trigger ) ;
} else {
push @ results , [ $ channel , $ trigger ] ;
}
2010-06-20 08:16:48 +02:00
}
2010-04-02 19:33:18 +02:00
}
}
2015-03-29 01:49:42 +01:00
# then check regex factoids
if ( not $ exact_trigger ) {
foreach my $ channel ( sort keys % { $ self - > { factoids } - > hash } ) {
if ( $ exact_channel ) {
next unless $ from eq lc $ channel or $ channel eq '.*' ;
}
2015-04-03 21:33:39 +02:00
foreach my $ trigger ( sort keys % { $ self - > { factoids } - > hash - > { $ channel } } ) {
2015-03-29 01:49:42 +01:00
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { type } eq 'regex' ) {
2015-07-22 00:07:56 +02:00
$ self - > { pbot } - > { logger } - > log ( "checking regex $string =~ m/$trigger/i\n" ) if $ debug >= 2 ;
2015-03-29 01:49:42 +01:00
if ( $ string =~ m/$trigger/i ) {
$ self - > { pbot } - > { logger } - > log ( "return regex $channel: $trigger\n" ) if $ debug ;
if ( $ find_alias ) {
my $ command = $ self - > { factoids } - > hash - > { $ channel } - > { $ trigger } - > { action } ;
2017-09-02 09:39:29 +02:00
( $ keyword , $ arguments ) = split /\s+/ , $ command , 2 ;
2015-03-29 01:49:42 +01:00
$ string = $ keyword . ( length $ arguments ? " $arguments" : "" ) ;
goto NEXT_DEPTH ;
}
2015-10-05 11:03:13 +02:00
if ( $ exact_channel == 1 ) {
2015-07-22 00:07:56 +02:00
return ( $ channel , $ trigger ) ;
} else {
push @ results , [ $ channel , $ trigger ] ;
}
2015-03-29 01:49:42 +01:00
}
}
}
}
}
NEXT_DEPTH:
last if not $ find_alias ;
2010-04-02 19:33:18 +02:00
}
2015-07-22 00:07:56 +02:00
if ( $ debug ) {
if ( not @ results ) {
$ self - > { pbot } - > { logger } - > log ( "find_factoid: no match\n" ) ;
} else {
$ self - > { pbot } - > { logger } - > log ( "find_factoid: got results: " . ( join ', ' , map { "$_->[0] -> $_->[1]" } @ results ) . "\n" ) ;
}
}
return @ results ;
2010-04-02 19:33:18 +02:00
} ;
if ( $@ ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "find_factoid: bad regex: $@\n" ) ;
2010-04-02 19:33:18 +02:00
return undef ;
}
2010-06-20 08:16:48 +02:00
return @ result ;
2010-04-10 00:55:24 +02:00
}
2017-09-24 06:04:21 +02:00
sub escape_json {
my ( $ self , $ text ) = @ _ ;
my $ thing = { thing = > $ text } ;
my $ json = encode_json $ thing ;
$ json =~ s/^{".*":"// ;
$ json =~ s/"}$// ;
return $ json ;
}
2017-10-10 04:39:54 +02:00
sub expand_special_vars {
my ( $ self , $ from , $ nick , $ root_keyword , $ action ) = @ _ ;
$ action =~ s/\$nick:json/$self->escape_json($nick)/ge ;
$ action =~ s/\$channel:json/$self->escape_json($from)/ge ;
$ action =~ s/\$randomnick:json/my $random = $self->{pbot}->{nicklist}->random_nick($from); $random ? $self->escape_json($random) : $self->escape_json($nick)/ge ;
$ action =~ s/\$0:json/$self->escape_json($root_keyword)/ge ;
$ action =~ s/\$nick/$nick/g ;
$ action =~ s/\$channel/$from/g ;
$ action =~ s/\$randomnick/my $random = $self->{pbot}->{nicklist}->random_nick($from); $random ? $random : $nick/ge ;
$ action =~ s/\$0\b/$root_keyword/g ;
return validate_string ( $ action ) ;
}
2015-07-07 04:39:33 +02:00
sub expand_factoid_vars {
2017-08-29 08:15:57 +02:00
my ( $ self , $ from , $ nick , $ root_keyword , $ action , @ exclude ) = @ _ ;
2017-08-28 04:52:36 +02:00
$ root_keyword = lc $ root_keyword ;
2015-07-07 04:39:33 +02:00
2017-08-23 09:21:46 +02:00
my $ depth = 0 ;
while ( 1 ) {
2017-11-16 18:23:58 +01:00
last if + + $ depth >= 100 ;
2017-08-23 09:21:46 +02:00
my $ matches = 0 ;
2017-10-10 04:39:54 +02:00
$ action =~ s/\$0/$root_keyword/g ;
2017-08-23 09:21:46 +02:00
my $ const_action = $ action ;
2017-08-26 08:36:11 +02:00
while ( $ const_action =~ /(\ba\s*|\ban\s*)?(?<!\\)\$([a-zA-Z0-9_:\-#\[\]]+)/gi ) {
2017-11-16 18:23:58 +01:00
last if + + $ depth >= 100 ;
2017-08-26 08:36:11 +02:00
my ( $ a , $ v ) = ( $ 1 , $ 2 ) ;
2017-08-26 12:45:58 +02:00
$ v =~ s/(.):$/$1/ ;
2017-11-29 03:30:09 +01:00
next if $ v =~ m/^[\W_]/ ; # special character prefix skipped for shell/code-factoids/etc
2017-09-24 06:04:21 +02:00
next if $ v =~ m/^(nick|channel|randomnick|arglen|args|arg\[.+\]|[_0])$/i ; # don't override special variables
2017-08-26 12:45:58 +02:00
next if @ exclude && grep { $ v =~ m/^\Q$_\E$/i } @ exclude ;
2017-08-23 09:21:46 +02:00
$ matches + + ;
my $ modifier = '' ;
if ( $ v =~ s/(:.*)$// ) {
$ modifier = $ 1 ;
}
2015-09-14 19:22:55 +02:00
2017-08-23 09:21:46 +02:00
if ( $ modifier =~ m/^:(#[^:]+|global)/i ) {
$ from = $ 1 ;
$ from = '.*' if lc $ from eq 'global' ;
}
2015-10-05 11:03:13 +02:00
2017-08-28 04:52:36 +02:00
my $ recurse = 0 ;
my $ test_v = $ v ;
ALIAS:
my @ factoids = $ self - > find_factoid ( $ from , $ test_v , undef , 2 , 2 ) ;
2017-08-23 09:21:46 +02:00
next if not @ factoids or not $ factoids [ 0 ] ;
2015-09-14 19:22:55 +02:00
2017-08-23 09:21:46 +02:00
my ( $ var_chan , $ var ) = ( $ factoids [ 0 ] - > [ 0 ] , $ factoids [ 0 ] - > [ 1 ] ) ;
2015-07-07 04:39:33 +02:00
2017-08-28 04:52:36 +02:00
if ( $ self - > { factoids } - > hash - > { $ var_chan } - > { $ var } - > { action } =~ m {^/call (.*)} ) {
$ test_v = $ 1 ;
next if + + $ recurse > 10 ;
goto ALIAS ;
}
2017-08-23 09:21:46 +02:00
if ( $ self - > { factoids } - > hash - > { $ var_chan } - > { $ var } - > { type } eq 'text' ) {
my $ change = $ self - > { factoids } - > hash - > { $ var_chan } - > { $ var } - > { action } ;
2017-09-02 10:44:57 +02:00
my @ list = split ( /\s|(".*?")/ , $ change ) ;
2017-08-23 09:21:46 +02:00
my @ mylist ;
for ( my $ i = 0 ; $ i <= $# list ; $ i + + ) {
2017-09-02 10:44:57 +02:00
push @ mylist , $ list [ $ i ] if defined $ list [ $ i ] and length $ list [ $ i ] ;
2017-08-23 09:21:46 +02:00
}
my $ line = int ( rand ( $# mylist + 1 ) ) ;
$ mylist [ $ line ] =~ s/"//g ;
2015-09-14 19:22:55 +02:00
2017-08-23 09:21:46 +02:00
foreach my $ mod ( split /:/ , $ modifier ) {
given ( $ mod ) {
when ( 'uc' ) {
$ mylist [ $ line ] = uc $ mylist [ $ line ] ;
}
when ( 'lc' ) {
$ mylist [ $ line ] = lc $ mylist [ $ line ] ;
}
when ( 'ucfirst' ) {
$ mylist [ $ line ] = ucfirst $ mylist [ $ line ] ;
}
when ( 'title' ) {
$ mylist [ $ line ] = ucfirst lc $ mylist [ $ line ] ;
}
2017-09-24 06:04:21 +02:00
when ( 'json' ) {
$ mylist [ $ line ] = $ self - > escape_json ( $ mylist [ $ line ] ) ;
}
2015-09-14 19:22:55 +02:00
}
}
2017-08-26 08:36:11 +02:00
if ( $ a ) {
my $ fixed_a = select_indefinite_article $ mylist [ $ line ] ;
2017-08-28 04:52:36 +02:00
$ action =~ s/$a\$$v$modifier/$fixed_a $mylist[$line]/ ;
2017-08-26 08:36:11 +02:00
} else {
2017-08-28 04:52:36 +02:00
$ action =~ s/\$$v$modifier/$mylist[$line]/ ;
2017-08-26 08:36:11 +02:00
}
2017-08-23 09:21:46 +02:00
}
2015-07-07 04:39:33 +02:00
}
2017-08-23 09:21:46 +02:00
last if $ matches == 0 ;
2015-07-07 04:39:33 +02:00
}
$ action =~ s/\\\$/\$/g ;
2017-08-29 08:15:57 +02:00
2017-08-31 12:10:20 +02:00
unless ( @ exclude ) {
2017-10-10 04:39:54 +02:00
$ action = $ self - > expand_special_vars ( $ from , $ nick , $ root_keyword , $ action ) ;
2017-08-31 12:10:20 +02:00
}
2017-08-29 08:15:57 +02:00
2017-09-05 09:27:28 +02:00
return validate_string ( $ action ) ;
2015-07-07 04:39:33 +02:00
}
2015-06-26 07:56:10 +02:00
sub expand_action_arguments {
my ( $ self , $ action , $ input , $ nick ) = @ _ ;
2017-09-05 09:27:28 +02:00
$ action = validate_string ( $ action ) ;
$ input = validate_string ( $ input ) ;
2017-09-12 14:50:49 +02:00
my % h ;
2015-06-26 07:56:10 +02:00
if ( not defined $ input or $ input eq '' ) {
2017-09-12 14:50:49 +02:00
% h = ( args = > $ nick ) ;
2015-06-26 07:56:10 +02:00
} else {
2017-09-12 14:50:49 +02:00
% h = ( args = > $ input ) ;
}
my $ jsonargs = encode_json \ % h ;
$ jsonargs =~ s/^{".*":"// ;
$ jsonargs =~ s/"}$// ;
if ( not defined $ input or $ input eq '' ) {
2017-11-19 23:37:02 +01:00
$ input = "" ;
2017-09-24 06:04:21 +02:00
$ action =~ s/\$args:json/$jsonargs/ge ;
2017-09-12 14:50:49 +02:00
$ action =~ s/\$args(?![[\w])/$nick/g ;
} else {
2017-09-24 06:04:21 +02:00
$ action =~ s/\$args:json/$jsonargs/g ;
2017-09-12 14:50:49 +02:00
$ action =~ s/\$args(?![[\w])/$input/g ;
2015-06-26 07:56:10 +02:00
}
2017-09-11 04:53:29 +02:00
my $ qinput = quotemeta $ input ;
$ qinput =~ s/\\ / /g ;
my @ args = shellwords ( $ qinput ) ;
$ action =~ s/\$arglen\b/scalar @args/eg ;
2015-07-02 00:21:08 +02:00
2017-11-12 17:04:42 +01:00
my $ depth = 0 ;
2017-08-02 06:31:58 +02:00
my $ const_action = $ action ;
while ( $ const_action =~ m/\$arg\[([^]]+)]/g ) {
2015-06-26 07:56:10 +02:00
my $ arg = $ 1 ;
2017-11-16 18:23:58 +01:00
last if + + $ depth >= 100 ;
2017-11-12 17:04:42 +01:00
2015-06-26 07:56:10 +02:00
if ( $ arg eq '*' ) {
if ( not defined $ input or $ input eq '' ) {
$ action =~ s/\$arg\[\*\]/$nick/ ;
} else {
$ action =~ s/\$arg\[\*\]/$input/ ;
}
next ;
}
if ( $ arg =~ m/([^:]*):(.*)/ ) {
my $ arg1 = $ 1 ;
my $ arg2 = $ 2 ;
my $ arg1i = $ arg1 ;
my $ arg2i = $ arg2 ;
$ arg1i = 0 if $ arg1i eq '' ;
$ arg2i = $# args if $ arg2i eq '' ;
$ arg2i = $# args if $ arg2i > $# args ;
my @ values = eval {
local $ SIG { __WARN__ } = sub { } ;
return @ args [ $ arg1i .. $ arg2i ] ;
} ;
if ( $@ ) {
next ;
} else {
my $ string = join ( ' ' , @ values ) ;
if ( $ string eq '' ) {
$ action =~ s/\s*\$arg\[$arg1:$arg2\]// ;
} else {
$ action =~ s/\$arg\[$arg1:$arg2\]/$string/ ;
}
}
next ;
}
my $ value = eval {
local $ SIG { __WARN__ } = sub { } ;
return $ args [ $ arg ] ;
} ;
if ( $@ ) {
next ;
} else {
if ( not defined $ value ) {
if ( $ arg == 0 ) {
$ action =~ s/\$arg\[$arg\]/$nick/ ;
} else {
$ action =~ s/\s*\$arg\[$arg\]// ;
}
} else {
$ action =~ s/\$arg\[$arg\]/$value/ ;
}
}
}
return $ action ;
}
2017-09-11 04:53:29 +02:00
sub execute_code_factoid_using_safe {
my ( $ self , $ nick , $ user , $ host , $ from , $ chan , $ root_keyword , $ keyword , $ arguments , $ lang , $ code , $ tonick ) = @ _ ;
2017-08-27 06:42:01 +02:00
2017-09-03 10:38:25 +02:00
return "/say code-factoids are temporarily disabled." ;
2017-08-27 06:42:01 +02:00
my $ ppi = PPI::Document - > new ( \ $ code , readonly = > 1 ) ;
return "/say $nick: I don't feel so good." if not $ ppi ;
my $ vars = $ ppi - > find ( sub { $ _ [ 1 ] - > isa ( 'PPI::Token::Symbol' ) } ) ;
2017-08-31 12:10:20 +02:00
2017-08-27 06:42:01 +02:00
my @ names = map { $ _ - > symbol =~ /^[\%\@\$]+(.*)/ ; $ 1 } @$ vars if $ vars ;
my % uniq = map { $ _ , 1 } @ names ;
@ names = keys % uniq ;
2017-08-31 12:10:20 +02:00
unless ( $ self - > { factoids } - > hash - > { $ chan } - > { $ keyword } - > { interpolate } eq '0' ) {
2017-09-06 02:22:47 +02:00
$ code = $ self - > expand_factoid_vars ( $ from , $ nick , $ root_keyword , $ code , @ names ) ;
2017-08-31 12:10:20 +02:00
}
2017-08-27 06:42:01 +02:00
my % signals = % SIG ;
alarm 0 ;
my $ safe ;
my $ new_compartment ;
if ( $ self - > { factoids } - > hash - > { $ chan } - > { $ keyword } - > { 'persist-key' } ) {
my $ key = $ self - > { factoids } - > hash - > { $ chan } - > { $ keyword } - > { 'persist-key' } ;
if ( $ self - > { compartments } - > { $ key } ) {
$ safe = $ self - > { compartments } - > { $ key } ;
} else {
$ new_compartment = $ key ;
}
}
if ( not defined $ safe ) {
$ safe = Safe - > new ;
2017-08-29 08:15:57 +02:00
$ safe - > permit_only ( qw/:base_core rv2gv padany rand srand concat subst join sort mapstart grepstart/ ) ;
2017-08-27 06:42:01 +02:00
$ safe - > deny ( qw/entersub/ ) ;
# some default stuff
$ safe - > reval ( '$" = " ";' ) ;
$ self - > { compartments } - > { $ new_compartment } = $ safe if $ new_compartment ;
}
2017-09-11 04:53:29 +02:00
no warnings ;
2017-08-27 06:42:01 +02:00
local our @ args = $ self - > { pbot } - > { commands } - > parse_arguments ( $ arguments ) ;
2017-09-06 02:22:47 +02:00
local our $ nick = $ nick ;
2017-08-27 06:42:01 +02:00
local our $ channel = $ from ;
2017-09-11 04:53:29 +02:00
use warnings ;
2017-08-27 06:42:01 +02:00
@ args = ( $ nick ) if not @ args ;
$ arguments = '' ;
$ safe - > share ( qw/@args $nick $channel/ ) ;
my $ action = eval {
$ self - > { pbot } - > { logger } - > log ( "evaling [$code]\n" ) ;
my $ result = $ safe - > reval ( $ code ) ;
if ( $@ ) {
my $ error = $@ ;
chomp $ error ;
$ error =~ s/trapped by operation.*/operation disallowed (we're still fine-tuning this; let us know if you think this should be allowed)/ ;
$ error =~ s/at \(eval \d+\) line 1.//g ;
$ error = "$error (did you forget to use quotes around factoid variables?)" if $ error =~ /syntax error/ ;
return "/say Error in factoid code: $error" ;
} else {
return $ result ;
}
} ;
if ( $@ ) {
my $ error = $@ ;
chomp $ error ;
$ error =~ s/at \(eval \d+\) line 1.//g ;
$ action = "/say Error in factoid: $error" ;
}
% SIG = % signals ;
alarm 1 ;
2017-08-31 12:10:20 +02:00
unless ( $ self - > { factoids } - > hash - > { $ chan } - > { $ keyword } - > { interpolate } eq '0' ) {
2017-09-06 02:22:47 +02:00
$ action = $ self - > expand_factoid_vars ( $ from , $ nick , $ root_keyword , $ action ) ;
$ action = $ self - > expand_action_arguments ( $ action , $ arguments , $ nick ) ;
2017-09-05 09:27:28 +02:00
} else {
$ action = validate_string ( $ action ) ;
2017-08-31 12:10:20 +02:00
}
2017-09-05 09:27:28 +02:00
2017-08-27 06:42:01 +02:00
return $ action ;
}
2017-09-11 04:53:29 +02:00
sub execute_code_factoid_using_vm {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff ) = @ _ ;
2017-09-11 04:53:29 +02:00
2017-11-16 18:23:58 +01:00
unless ( exists $ self - > { factoids } - > hash - > { $ stuff - > { channel } } - > { $ stuff - > { keyword } } - > { interpolate } and $ self - > { factoids } - > hash - > { $ stuff - > { channel } } - > { $ stuff - > { keyword } } - > { interpolate } eq '0' ) {
$ stuff - > { code } = $ self - > expand_factoid_vars ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { root_keyword } , $ stuff - > { code } ) ;
$ stuff - > { code } = $ self - > expand_action_arguments ( $ stuff - > { code } , $ stuff - > { arguments } , $ stuff - > { nick } ) ;
2017-09-11 04:53:29 +02:00
}
2017-11-16 18:23:58 +01:00
my % h = ( nick = > $ stuff - > { nick } , channel = > $ stuff - > { from } , lang = > $ stuff - > { lang } , code = > $ stuff - > { code } , arguments = > $ stuff - > { arguments } , factoid = > "$stuff->{channel}:$stuff->{keyword}" ) ;
2017-09-19 06:36:40 +02:00
2017-11-16 18:23:58 +01:00
if ( exists $ self - > { factoids } - > hash - > { $ stuff - > { channel } } - > { $ stuff - > { keyword } } - > { 'persist-key' } ) {
$ h { 'persist-key' } = $ self - > { factoids } - > hash - > { $ stuff - > { channel } } - > { $ stuff - > { keyword } } - > { 'persist-key' } ;
2017-09-19 06:36:40 +02:00
}
2017-11-28 04:18:00 +01:00
# not sure why we need this here, but it seems to stop strange
# text encoding issues in the following encode_json call
use Encode ;
$ h { arguments } = decode ( 'utf8' , $ h { arguments } ) ;
2017-09-12 14:50:49 +02:00
my $ json = encode_json \ % h ;
2017-11-16 18:23:58 +01:00
2017-11-27 11:14:34 +01:00
$ stuff - > { special } = 'code-factoid' ;
2017-11-16 18:23:58 +01:00
$ stuff - > { root_channel } = $ stuff - > { channel } ;
$ stuff - > { keyword } = 'compiler' ;
$ stuff - > { arguments } = $ json ;
$ self - > { pbot } - > { factoids } - > { factoidmodulelauncher } - > execute_module ( $ stuff ) ;
2017-09-11 04:53:29 +02:00
return "" ;
}
sub execute_code_factoid {
2017-11-27 11:14:34 +01:00
my ( $ self , @ args ) = @ _ ;
return $ self - > execute_code_factoid_using_vm ( @ args ) ;
2017-09-11 04:53:29 +02:00
}
2010-03-22 08:33:44 +01:00
sub interpreter {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff ) = @ _ ;
2010-03-22 08:33:44 +01:00
my $ pbot = $ self - > { pbot } ;
2017-11-21 01:10:48 +01:00
if ( $ self - > { pbot } - > { registry } - > get_value ( 'general' , 'debugcontext' ) ) {
use Data::Dumper ;
$ Data:: Dumper:: Sortkeys = 1 ;
$ self - > { pbot } - > { logger } - > log ( "Factoids::interpreter\n" ) ;
$ self - > { pbot } - > { logger } - > log ( Dumper $ stuff ) ;
}
2017-11-16 18:23:58 +01:00
2015-09-04 05:56:44 +02:00
#$self->{pbot}->{logger}->log("enter factoid interpreter [$keyword][" . (defined $arguments ? $arguments : '') . "] referenced = $referenced\n");
2017-11-16 18:23:58 +01:00
return undef if not length $ stuff - > { keyword } or $ stuff - > { interpret_depth } > $ self - > { pbot } - > { registry } - > get_value ( 'interpreter' , 'max_recursion' ) ;
2010-06-30 13:36:45 +02:00
2017-11-16 18:23:58 +01:00
$ stuff - > { from } = lc $ stuff - > { from } ;
2012-07-22 21:22:30 +02:00
2011-01-30 07:29:05 +01:00
# search for factoid against global channel and current channel (from unless ref_from is defined)
2017-11-16 18:23:58 +01:00
my $ original_keyword = $ stuff - > { keyword } ;
2014-05-18 22:09:05 +02:00
#$self->{pbot}->{logger}->log("calling find_factoid in Factoids.pm, interpreter() to search for factoid against global/current\n");
2017-11-16 18:23:58 +01:00
my ( $ channel , $ keyword ) = $ self - > find_factoid ( $ stuff - > { ref_from } ? $ stuff - > { ref_from } : $ stuff - > { from } , $ stuff - > { keyword } , $ stuff - > { arguments } , 1 ) ;
2011-01-30 07:29:05 +01:00
2017-11-16 18:23:58 +01:00
if ( not $ stuff - > { ref_from } or $ stuff - > { ref_from } eq '.*' ) {
$ stuff - > { ref_from } = "" ;
2012-07-22 21:22:30 +02:00
}
2017-11-16 18:23:58 +01:00
if ( defined $ channel and not $ channel eq '.*' and not lc $ channel eq $ stuff - > { from } ) {
$ stuff - > { ref_from } = "[$channel] " ;
2011-01-30 07:29:05 +01:00
}
2017-11-16 18:23:58 +01:00
$ stuff - > { arguments } = "" if not defined $ stuff - > { 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
2017-11-16 18:23:58 +01:00
if ( not defined $ keyword ) {
my $ string = "$original_keyword $stuff->{arguments}" ;
2014-10-14 04:30:14 +02:00
my $ lc_keyword = lc $ original_keyword ;
2011-01-29 02:21:17 +01:00
my $ comma = "" ;
my $ found = 0 ;
2014-10-14 04:30:14 +02:00
my $ chans = "" ;
2011-01-29 02:21:17 +01:00
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
2014-05-18 22:09:05 +02:00
foreach my $ chan ( keys % { $ self - > { factoids } - > hash } ) {
foreach my $ trig ( keys % { $ self - > { factoids } - > hash - > { $ chan } } ) {
2014-10-14 04:30:14 +02:00
my $ type = $ self - > { factoids } - > hash - > { $ chan } - > { $ trig } - > { type } ;
2017-11-16 18:23:58 +01:00
if ( ( $ type eq 'text' or $ type eq 'module' ) and lc $ trig eq $ lc_keyword ) {
2011-01-29 02:21:17 +01:00
$ 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
2017-11-16 18:23:58 +01:00
if ( $ found > 1 ) {
return undef if $ stuff - > { referenced } ;
return $ stuff - > { ref_from } . "Ambiguous keyword '$original_keyword' exists in multiple channels (use 'fact <channel> <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
2017-11-16 18:23:58 +01:00
elsif ( $ found == 1 ) {
2014-05-18 22:09:05 +02:00
$ pbot - > { logger } - > log ( "Found '$original_keyword' as '$fwd_trig' in [$fwd_chan]\n" ) ;
2017-11-16 18:23:58 +01:00
$ stuff - > { keyword } = $ fwd_trig ;
$ stuff - > { interpret_depth } + + ;
$ stuff - > { ref_from } = $ fwd_chan ;
return $ pbot - > { factoids } - > interpreter ( $ stuff ) ;
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
2017-11-16 18:23:58 +01:00
return undef if length $ stuff - > { arguments } and not $ self - > { pbot } - > { nicklist } - > is_present ( $ stuff - > { from } , $ stuff - > { arguments } ) ;
2011-01-30 07:29:05 +01:00
2017-11-16 18:23:58 +01:00
my $ matches = $ self - > { commands } - > factfind ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { user } , $ stuff - > { host } , quotemeta $ original_keyword ) ;
2012-11-04 21:42:38 +01:00
# found factfind matches
2017-11-16 18:23:58 +01:00
if ( $ matches !~ m/^No factoids/ ) {
return undef if $ stuff - > { referenced } ;
2013-02-25 03:27:24 +01:00
return "No such factoid '$original_keyword'; $matches" ;
2012-11-04 21:42:38 +01:00
}
# otherwise find levenshtein closest matches from all channels
2014-05-18 22:09:05 +02:00
$ 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' ;
2017-11-16 18:23:58 +01:00
return undef if $ stuff - > { referenced } ;
2010-06-20 08:16:48 +02:00
2017-11-16 18:23:58 +01:00
return $ stuff - > { ref_from } . "No such factoid '$original_keyword'; did you mean $matches?" ;
2011-01-29 02:21:17 +01:00
}
2010-06-20 08:16:48 +02:00
}
2017-11-27 11:14:34 +01:00
$ stuff - > { keyword } = $ keyword ;
$ stuff - > { trigger } = $ keyword ;
$ stuff - > { channel } = $ channel ;
$ stuff - > { original_keyword } = $ original_keyword ;
2017-11-16 18:23:58 +01:00
return undef if $ stuff - > { referenced } and $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { noembed } ;
2015-09-04 05:56:44 +02:00
2017-11-16 18:23:58 +01:00
if ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } ) {
if ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } ) {
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } eq $ stuff - > { from } ) {
if ( gettimeofday - $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } < $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { rate_limit } ) {
return "/msg $stuff->{nick} $stuff->{ref_from}'$keyword' is rate-limited; try again in " . duration ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { rate_limit } - int ( gettimeofday - $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } ) ) . "." unless $ self - > { pbot } - > { admins } - > loggedin ( $ channel , "$stuff->{nick}!$stuff->{user}\@$stuff->{host}" ) ;
2015-04-03 19:11:21 +02:00
}
}
}
}
2014-05-18 22:09:05 +02:00
my $ type = $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { type } ;
2010-03-24 07:47:40 +01:00
2015-04-03 19:11:21 +02:00
$ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { ref_count } + + ;
2017-11-16 18:23:58 +01:00
$ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { ref_user } = "$stuff->{nick}!$stuff->{user}\@$stuff->{host}" ;
2015-04-03 19:11:21 +02:00
$ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_on } = gettimeofday ;
2017-11-16 18:23:58 +01:00
$ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { last_referenced_in } = $ stuff - > { from } || "stdin" ;
2010-06-20 08:16:48 +02:00
2017-08-27 13:18:31 +02:00
my $ action ;
2017-11-16 18:23:58 +01:00
if ( length $ stuff - > { arguments } and exists $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { action_with_args } ) {
2017-08-27 13:18:31 +02:00
$ action = $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { action_with_args } ;
} else {
$ action = $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { action } ;
}
2010-04-02 19:33:18 +02:00
2017-09-11 04:53:29 +02:00
if ( $ action =~ m {^/code\s+([^\s]+)\s+(.+)$}i ) {
my ( $ lang , $ code ) = ( $ 1 , $ 2 ) ;
2017-11-16 18:23:58 +01:00
$ stuff - > { lang } = $ lang ;
$ stuff - > { code } = $ code ;
$ self - > execute_code_factoid ( $ stuff ) ;
2017-09-11 04:53:29 +02:00
return "" ;
2017-08-24 04:25:43 +02:00
}
2017-11-16 18:23:58 +01:00
return $ self - > handle_action ( $ stuff , $ action ) ;
2017-09-11 04:53:29 +02:00
}
sub handle_action {
2017-11-16 18:23:58 +01:00
my ( $ self , $ stuff , $ action ) = @ _ ;
2017-11-21 01:10:48 +01:00
if ( $ self - > { pbot } - > { registry } - > get_value ( 'general' , 'debugcontext' ) ) {
use Data::Dumper ;
$ Data:: Dumper:: Sortkeys = 1 ;
$ self - > { pbot } - > { logger } - > log ( "Factoids::handle_action [$action]\n" ) ;
$ self - > { pbot } - > { logger } - > log ( Dumper $ stuff ) ;
}
2017-09-11 04:53:29 +02:00
2017-08-27 13:18:31 +02:00
return "" if not length $ action ;
2017-08-27 06:42:01 +02:00
2017-11-27 11:14:34 +01:00
my ( $ channel , $ keyword ) = ( $ stuff - > { channel } , $ stuff - > { trigger } ) ;
2017-11-16 18:23:58 +01:00
2017-09-11 04:53:29 +02:00
unless ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { interpolate } and $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { interpolate } eq '0' ) {
2017-11-16 18:23:58 +01:00
$ action = $ self - > expand_factoid_vars ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { root_keyword } , $ action ) ;
2017-08-31 12:10:20 +02:00
}
2017-11-16 18:23:58 +01:00
if ( length $ stuff - > { arguments } ) {
2017-10-10 04:39:54 +02:00
if ( $ action =~ m/\$args/ or $ action =~ m/\$arg\[/ ) {
2017-11-16 18:23:58 +01:00
unless ( defined $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { interpolate } and $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { interpolate } eq '0' ) {
$ action = $ self - > expand_action_arguments ( $ action , $ stuff - > { arguments } , $ stuff - > { nick } ) ;
2017-08-31 12:10:20 +02:00
}
2017-11-16 18:23:58 +01:00
$ stuff - > { arguments } = "" ;
2015-06-26 07:56:10 +02:00
} else {
2015-07-02 00:21:08 +02:00
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'text' ) {
2017-11-16 18:23:58 +01:00
my $ target = $ self - > { pbot } - > { nicklist } - > is_present_similar ( $ stuff - > { from } , $ stuff - > { arguments } ) ;
2016-10-14 14:56:54 +02:00
2017-09-11 04:53:29 +02:00
if ( $ target and $ action !~ /\$(?:nick|args)\b/ ) {
2017-11-26 05:00:55 +01:00
$ stuff - > { nickoverride } = $ target ;
2015-04-03 19:11:21 +02:00
}
2010-08-14 11:45:58 +02:00
}
}
2015-04-03 19:11:21 +02:00
} else {
2017-08-27 13:18:31 +02:00
# no arguments supplied, replace $args with $nick/$tonick, etc
2017-11-16 18:23:58 +01:00
$ action = $ self - > expand_action_arguments ( $ action , undef , $ stuff - > { nick } ) ;
2010-06-21 17:23:46 +02:00
}
2015-04-15 05:14:22 +02:00
# Check if it's an alias
2017-11-16 18:23:58 +01:00
if ( $ action =~ /^\/call\s+(.*)$/ ) {
my $ command = $ self - > expand_factoid_vars ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { root_keyword } , $ 1 ) ;
if ( length $ stuff - > { arguments } ) {
$ command . = " $stuff->{arguments}" ;
2015-04-15 05:14:22 +02:00
}
2017-11-16 18:23:58 +01:00
$ stuff - > { command } = $ command ;
$ self - > { pbot } - > { logger } - > log ( "[" . ( defined $ stuff - > { from } ? $ stuff - > { from } : "stdin" ) . "] ($stuff->{nick}!$stuff->{user}\@$stuff->{host}) [$keyword] aliased to: [$command]\n" ) ;
return $ self - > { pbot } - > { interpreter } - > interpret ( $ stuff ) ;
2015-04-15 05:14:22 +02:00
}
2017-11-16 18:23:58 +01:00
$ self - > { pbot } - > { logger } - > log ( "(" . ( defined $ stuff - > { from } ? $ stuff - > { from } : "(undef)" ) . "): $stuff->{nick}!$stuff->{user}\@$stuff->{host}: $keyword: action: \"$action\"\n" ) ;
2010-04-02 19:33:18 +02:00
2017-11-16 18:23:58 +01:00
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { enabled } == 0 ) {
2015-04-03 19:11:21 +02:00
$ self - > { pbot } - > { logger } - > log ( "$keyword disabled.\n" ) ;
2017-11-16 18:23:58 +01:00
return "/msg $stuff->{nick} $stuff->{ref_from}$keyword is currently disabled." ;
2015-04-03 19:11:21 +02:00
}
2010-03-22 08:33:44 +01:00
2017-09-11 04:53:29 +02:00
unless ( exists $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { interpolate } and $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { interpolate } eq '0' ) {
2017-11-16 18:23:58 +01:00
$ action = $ self - > expand_factoid_vars ( $ stuff - > { from } , $ stuff - > { nick } , $ stuff - > { root_keyword } , $ action ) ;
$ action = $ self - > expand_action_arguments ( $ action , $ stuff - > { arguments } , $ stuff - > { nick } ) ;
2017-08-31 12:10:20 +02:00
}
2017-08-27 06:42:01 +02:00
2017-11-27 11:14:34 +01:00
return $ action if $ stuff - > { special } eq 'code-factoid' ;
2017-11-16 18:23:58 +01:00
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'module' ) {
2015-04-03 19:11:21 +02:00
my $ preserve_whitespace = $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { preserve_whitespace } ;
$ preserve_whitespace = 0 if not defined $ preserve_whitespace ;
2010-04-02 19:33:18 +02:00
2017-11-16 18:23:58 +01:00
$ stuff - > { preserve_whitespace } = $ preserve_whitespace ;
$ stuff - > { root_keyword } = $ keyword unless defined $ stuff - > { root_keyword } ;
$ stuff - > { root_channel } = $ channel ;
2010-06-20 08:16:48 +02:00
2017-11-21 01:12:13 +01:00
my $ result = $ self - > { factoidmodulelauncher } - > execute_module ( $ stuff ) ;
if ( length $ result ) {
return $ stuff - > { ref_from } . $ result ;
} else {
return "" ;
}
2017-11-16 18:23:58 +01:00
}
elsif ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'text' ) {
2015-04-03 19:11:21 +02:00
# Don't allow user-custom /msg factoids, unless factoid triggered by admin
2017-11-16 18:23:58 +01:00
if ( ( $ action =~ m/^\/msg/i ) and ( not $ self - > { pbot } - > { admins } - > loggedin ( $ stuff - > { from } , "$stuff->{nick}!$stuff->{user}\@$stuff->{host}" ) ) ) {
2015-04-03 19:11:21 +02:00
$ self - > { pbot } - > { logger } - > log ( "[ABUSE] Bad factoid (contains /msg): $action\n" ) ;
2017-11-16 18:23:58 +01:00
return "You must login to use this command." ;
2010-03-22 08:33:44 +01:00
}
2010-04-02 19:33:18 +02:00
2017-11-16 18:23:58 +01:00
if ( $ stuff - > { ref_from } ) {
if ( $ action =~ s/^\/say\s+/$stuff->{ref_from}/i || $ action =~ s/^\/me\s+(.*)/\/me $1 $stuff->{ref_from}/i
|| $ action =~ s/^\/msg\s+([^ ]+)/\/msg $1 $stuff->{ref_from}/i ) {
2015-04-03 19:11:21 +02:00
return $ action ;
2013-10-12 17:06:27 +02:00
} else {
2017-11-16 18:23:58 +01:00
return $ stuff - > { ref_from } . "$keyword is $action" ;
2013-10-12 17:06:27 +02:00
}
2013-10-14 19:22:06 +02:00
} else {
2016-11-17 04:07:01 +01:00
if ( $ action =~ m/^\/(?:say|me|msg)/i ) {
2015-04-03 19:11:21 +02:00
return $ action ;
2016-11-17 04:07:01 +01:00
} elsif ( $ action =~ s/^\/kick\s+// ) {
if ( not exists $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { 'effective-level' } ) {
2017-11-18 06:37:54 +01:00
$ stuff - > { authorized } = 0 ;
2017-11-16 18:23:58 +01:00
return "/say $stuff->{nick}: $keyword doesn't have the effective-level to do that." ;
2016-11-17 04:07:01 +01:00
}
my $ level = 10 ;
2016-11-17 04:14:00 +01:00
if ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { 'effective-level' } >= $ level ) {
2017-11-18 06:37:54 +01:00
$ stuff - > { authorized } = 1 ;
return "/kick " . $ action ;
2016-11-17 04:07:01 +01:00
} else {
2017-11-18 06:37:54 +01:00
$ stuff - > { authorized } = 0 ;
2017-11-16 18:23:58 +01:00
return "/say $stuff->{nick}: My effective-level isn't high enough to do that." ;
2016-11-17 04:07:01 +01:00
}
2013-10-14 19:22:06 +02:00
} else {
2017-09-02 09:14:13 +02:00
return "/say $keyword is $action" ;
2013-10-14 19:22:06 +02:00
}
2010-04-02 19:33:18 +02:00
}
2014-05-18 22:09:05 +02:00
} elsif ( $ self - > { factoids } - > hash - > { $ channel } - > { $ keyword } - > { type } eq 'regex' ) {
2017-09-11 04:53:29 +02:00
my $ result = eval {
2017-11-16 18:23:58 +01:00
my $ string = "$stuff->{original_keyword}" . ( defined $ stuff - > { arguments } ? " $stuff->{arguments}" : "" ) ;
2010-06-30 05:48:13 +02:00
my $ cmd ;
2017-11-16 18:23:58 +01:00
if ( $ string =~ m/$keyword/i ) {
2015-04-03 19:11:21 +02:00
$ self - > { pbot } - > { logger } - > log ( "[$string] matches [$keyword] - calling [" . $ action . "$']\n" ) ;
$ cmd = $ 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 {
2015-04-03 19:11:21 +02:00
$ cmd = $ action ;
2010-04-02 19:33:18 +02:00
}
2010-06-30 05:48:13 +02:00
2017-11-16 18:23:58 +01:00
$ stuff - > { command } = $ cmd ;
return $ self - > { pbot } - > { interpreter } - > interpret ( $ stuff ) ;
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 ( $@ ) {
2014-05-18 22:09:05 +02:00
$ self - > { pbot } - > { logger } - > log ( "Regex fail: $@\n" ) ;
2014-10-14 04:30:14 +02:00
return "" ;
2010-04-02 19:33:18 +02:00
}
2017-11-21 01:12:13 +01:00
if ( length $ result ) {
return $ stuff - > { ref_from } . $ result ;
} else {
return "" ;
}
2010-04-02 19:33:18 +02:00
} else {
2017-11-16 18:23:58 +01:00
$ self - > { pbot } - > { logger } - > log ( "($stuff->{from}): $stuff->{nick}!$stuff->{user}\@$stuff->{host}): Unknown command type for '$keyword'\n" ) ;
return "/me blinks." . " $stuff->{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 ;