2010-03-17 07:36:54 +01:00
|
|
|
# File: Interpreter.pm
|
2010-03-22 08:33:44 +01:00
|
|
|
# Author: pragma_
|
2010-03-17 07:36:54 +01:00
|
|
|
#
|
2010-03-22 08:33:44 +01:00
|
|
|
# Purpose:
|
2010-03-17 07:36:54 +01:00
|
|
|
|
|
|
|
package PBot::Interpreter;
|
|
|
|
|
|
|
|
use warnings;
|
|
|
|
use strict;
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
use base 'PBot::Registerable';
|
|
|
|
|
2010-04-13 06:17:54 +02:00
|
|
|
use LWP::UserAgent;
|
2010-03-22 08:33:44 +01:00
|
|
|
use Carp ();
|
|
|
|
|
2010-03-24 07:47:40 +01:00
|
|
|
use vars qw($VERSION);
|
|
|
|
$VERSION = '1.0.0';
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
sub new {
|
|
|
|
if(ref($_[1]) eq 'HASH') {
|
|
|
|
Carp::croak("Options to Interpreter should be key/value pairs, not hash reference");
|
|
|
|
}
|
|
|
|
|
|
|
|
my ($class, %conf) = @_;
|
|
|
|
|
|
|
|
my $self = bless {}, $class;
|
|
|
|
$self->initialize(%conf);
|
|
|
|
return $self;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
sub initialize {
|
|
|
|
my ($self, %conf) = @_;
|
|
|
|
|
|
|
|
$self->SUPER::initialize(%conf);
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
my $pbot = delete $conf{pbot};
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
if(not defined $pbot) {
|
|
|
|
Carp::croak("Missing pbot reference to PBot::Interpreter");
|
|
|
|
}
|
|
|
|
|
|
|
|
$self->{pbot} = $pbot;
|
|
|
|
}
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2010-04-13 06:17:54 +02:00
|
|
|
sub paste_codepad {
|
|
|
|
my $text = join(' ', @_);
|
|
|
|
|
|
|
|
$text =~ s/(.{120})\s/$1\n/g;
|
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new();
|
|
|
|
$ua->agent("Mozilla/5.0");
|
|
|
|
push @{ $ua->requests_redirectable }, 'POST';
|
|
|
|
|
|
|
|
my %post = ( 'lang' => 'Plain Text', 'code' => $text, 'private' => 'True', 'submit' => 'Submit' );
|
|
|
|
my $response = $ua->post("http://codepad.org", \%post);
|
|
|
|
|
|
|
|
if(not $response->is_success) {
|
|
|
|
return $response->status_line;
|
|
|
|
}
|
|
|
|
|
|
|
|
return $response->request->uri;
|
|
|
|
}
|
2012-07-22 21:22:30 +02:00
|
|
|
|
2012-10-27 23:03:10 +02:00
|
|
|
sub paste_sprunge {
|
2012-07-22 21:22:30 +02:00
|
|
|
my $text = join(' ', @_);
|
|
|
|
|
|
|
|
$text =~ s/(.{120})\s/$1\n/g;
|
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new();
|
|
|
|
$ua->agent("Mozilla/5.0");
|
|
|
|
$ua->requests_redirectable([ ]);
|
|
|
|
|
|
|
|
my %post = ( 'sprunge' => $text, 'submit' => 'Submit' );
|
|
|
|
my $response = $ua->post("http://sprunge.us", \%post);
|
|
|
|
|
|
|
|
if(not $response->is_success) {
|
|
|
|
return $response->status_line;
|
|
|
|
}
|
|
|
|
|
|
|
|
my $result = $response->content;
|
|
|
|
$result =~ s/^\s+//;
|
|
|
|
$result =~ s/\s+$//;
|
|
|
|
return $result;
|
|
|
|
}
|
2010-04-13 06:17:54 +02:00
|
|
|
|
2010-03-17 07:36:54 +01:00
|
|
|
sub process_line {
|
2010-03-22 08:33:44 +01:00
|
|
|
my $self = shift;
|
2010-03-17 07:36:54 +01:00
|
|
|
my ($from, $nick, $user, $host, $text) = @_;
|
2012-07-22 21:22:30 +02:00
|
|
|
|
2010-03-17 07:36:54 +01:00
|
|
|
my ($command, $args, $result);
|
2012-07-22 21:22:30 +02:00
|
|
|
my $has_url;
|
|
|
|
my $has_code;
|
|
|
|
my $nick_override;
|
2010-03-22 08:33:44 +01:00
|
|
|
my $mynick = $self->pbot->botnick;
|
2010-03-17 07:36:54 +01:00
|
|
|
|
|
|
|
$from = lc $from if defined $from;
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
my $pbot = $self->pbot;
|
|
|
|
|
2010-06-06 06:41:15 +02:00
|
|
|
$pbot->antiflood->check_flood($from, $nick, $user, $host, $text, $pbot->{MAX_FLOOD_MESSAGES}, 10, $pbot->antiflood->{FLOOD_CHAT}) if defined $from;
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2013-07-24 14:33:19 +02:00
|
|
|
$text =~ s/^\s+//;
|
|
|
|
$text =~ s/\s+$//;
|
2012-07-22 21:22:30 +02:00
|
|
|
my $preserve_whitespace = 0;
|
|
|
|
|
2013-07-24 14:33:19 +02:00
|
|
|
my $cmd_text = $text;
|
|
|
|
$cmd_text =~ s/^\/me\s+//;
|
|
|
|
|
2014-02-25 04:47:12 +01:00
|
|
|
if($cmd_text =~ /^$pbot->{trigger}?\s*{\s*(.*)\s*}\s*$/) {
|
|
|
|
$has_code = $1 if length $1;
|
|
|
|
$preserve_whitespace = 1;
|
|
|
|
} elsif($cmd_text =~ /^\Q$pbot->{trigger}\E(.*)$/) {
|
2012-08-24 00:50:07 +02:00
|
|
|
$command = $1;
|
2013-07-24 14:33:19 +02:00
|
|
|
} elsif($cmd_text =~ /^.?$mynick.?\s+(.*?)$/i) {
|
2012-08-24 00:50:07 +02:00
|
|
|
$command = $1;
|
2013-07-24 14:33:19 +02:00
|
|
|
} elsif($cmd_text =~ /^(.*?),?\s+$mynick[?!.]*$/i) {
|
2012-08-24 00:50:07 +02:00
|
|
|
$command = $1;
|
2013-07-24 14:33:19 +02:00
|
|
|
} elsif($cmd_text =~ /https?:\/\/([^\s]+)/i) {
|
2010-03-17 07:36:54 +01:00
|
|
|
$has_url = $1;
|
2013-07-24 14:33:19 +02:00
|
|
|
} elsif($cmd_text =~ /^\s*([^,:\(\)\+\*\/ ]+)[,:]*\s*{\s*(.*)\s*}\s*$/) {
|
2012-07-22 21:22:30 +02:00
|
|
|
$nick_override = $1;
|
|
|
|
$has_code = $2 if length $2 and $nick_override ne 'enum' and $nick_override ne 'struct';
|
|
|
|
$preserve_whitespace = 1;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
2012-07-22 21:22:30 +02:00
|
|
|
if(defined $command || defined $has_url || defined $has_code) {
|
|
|
|
if((defined $command && $command !~ /^login/i) || defined $has_url || defined $has_code) {
|
2010-03-22 08:33:44 +01:00
|
|
|
if(defined $from && $pbot->ignorelist->check_ignore($nick, $user, $host, $from) && not $pbot->admins->loggedin($from, "$nick!$user\@$host")) {
|
|
|
|
# ignored hostmask
|
|
|
|
$pbot->logger->log("ignored text: [$from][$nick!$user\@$host\[$text\]\n");
|
|
|
|
return;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2012-07-22 21:22:30 +02:00
|
|
|
if(defined $has_url) {
|
2010-03-22 08:33:44 +01:00
|
|
|
$result = $self->{pbot}->factoids->{factoidmodulelauncher}->execute_module($from, undef, $nick, $user, $host, "title", "$nick http://$has_url");
|
2012-07-22 21:22:30 +02:00
|
|
|
} elsif(defined $has_code) {
|
2012-08-12 18:41:38 +02:00
|
|
|
$result = $self->{pbot}->factoids->{factoidmodulelauncher}->execute_module($from, undef, $nick, $user, $host, "compiler_block", (defined $nick_override ? $nick_override : $nick) . " $has_code }");
|
2012-07-22 21:22:30 +02:00
|
|
|
} else {
|
|
|
|
$result = $self->interpret($from, $nick, $user, $host, 1, $command);
|
2010-04-17 21:22:22 +02:00
|
|
|
}
|
2010-03-17 07:36:54 +01:00
|
|
|
|
|
|
|
if(defined $result && length $result > 0) {
|
2011-02-10 08:10:50 +01:00
|
|
|
my $original_result = $result;
|
|
|
|
$result =~ s/[\n\r]+/ /g;
|
2012-07-22 21:22:30 +02:00
|
|
|
|
|
|
|
if($preserve_whitespace == 0 && defined $command) {
|
|
|
|
my ($cmd, $args) = split / /, $command, 2;
|
|
|
|
#$self->{pbot}->logger->log("calling find_factoid in Interpreter.pm, process_line() for preserve_whitespace\n");
|
|
|
|
my ($chan, $trigger) = $self->{pbot}->factoids->find_factoid($from, $cmd, $args, 0, 1);
|
|
|
|
if(defined $trigger) {
|
|
|
|
$preserve_whitespace = $self->{pbot}->factoids->factoids->hash->{$chan}->{$trigger}->{preserve_whitespace};
|
|
|
|
$preserve_whitespace = 0 if not defined $preserve_whitespace;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
$result =~ s/\s+/ /g unless $preserve_whitespace;
|
|
|
|
|
2011-02-10 08:10:50 +01:00
|
|
|
if(length $result > $pbot->max_msg_len) {
|
2012-10-27 23:03:10 +02:00
|
|
|
my $link = paste_sprunge("[" . (defined $from ? $from : "stdin") . "] <$nick> $text\n\n$original_result");
|
2011-02-10 08:10:50 +01:00
|
|
|
my $trunc = "... [truncated; see $link for full text.]";
|
|
|
|
$pbot->logger->log("Message truncated -- pasted to $link\n");
|
2010-04-17 21:22:22 +02:00
|
|
|
|
2011-02-10 08:10:50 +01:00
|
|
|
my $trunc_len = length $result < $pbot->max_msg_len ? length $result : $pbot->max_msg_len;
|
|
|
|
$result = substr($result, 0, $trunc_len);
|
|
|
|
substr($result, $trunc_len - length $trunc) = $trunc;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->logger->log("Final result: $result\n");
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2013-10-12 17:06:27 +02:00
|
|
|
if($result =~ s/^\/say\s+//i) {
|
|
|
|
$pbot->conn->privmsg($from, $result) if defined $from && $from !~ /\Q$mynick\E/i;
|
2013-10-22 20:57:08 +02:00
|
|
|
$pbot->antiflood->check_flood($from, $pbot->{botnick}, $pbot->{username}, 'localhost', $result, 0, 0, 0);
|
2013-10-12 17:06:27 +02:00
|
|
|
} elsif($result =~ s/^\/me\s+//i) {
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->conn->me($from, $result) if defined $from && $from !~ /\Q$mynick\E/i;
|
2013-10-22 20:57:08 +02:00
|
|
|
$pbot->antiflood->check_flood($from, $pbot->{botnick}, $pbot->{username}, 'localhost', '/me ' . $result, 0, 0, 0);
|
2010-03-17 07:36:54 +01:00
|
|
|
} elsif($result =~ s/^\/msg\s+([^\s]+)\s+//i) {
|
|
|
|
my $to = $1;
|
2013-10-12 17:06:27 +02:00
|
|
|
if($to =~ /,/) {
|
|
|
|
$pbot->logger->log("[HACK] Possible HACK ATTEMPT /msg multiple users: [$nick!$user\@$host] [$command] [$result]\n");
|
|
|
|
}
|
|
|
|
elsif($to =~ /.*serv$/i) {
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->logger->log("[HACK] Possible HACK ATTEMPT /msg *serv: [$nick!$user\@$host] [$command] [$result]\n");
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
elsif($result =~ s/^\/me\s+//i) {
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->conn->me($to, $result) if $to !~ /\Q$mynick\E/i;
|
2013-10-22 20:57:08 +02:00
|
|
|
$pbot->antiflood->check_flood($to, $pbot->{botnick}, $pbot->{username}, 'localhost', '/me ' . $result, 0, 0, 0);
|
2010-03-17 07:36:54 +01:00
|
|
|
} else {
|
|
|
|
$result =~ s/^\/say\s+//i;
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->conn->privmsg($to, $result) if $to !~ /\Q$mynick\E/i;
|
2013-10-22 20:57:08 +02:00
|
|
|
$pbot->antiflood->check_flood($to, $pbot->{botnick}, $pbot->{username}, 'localhost', $result, 0, 0, 0);
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
} else {
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->conn->privmsg($from, $result) if defined $from && $from !~ /\Q$mynick\E/i;
|
2013-10-22 20:57:08 +02:00
|
|
|
$pbot->antiflood->check_flood($from, $pbot->{botnick}, $pbot->{username}, 'localhost', $result, 0, 0, 0);
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
}
|
2013-10-22 20:57:08 +02:00
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->logger->log("---------------------------------------------\n");
|
|
|
|
|
|
|
|
# TODO: move this to FactoidModuleLauncher somehow, completely out of Interpreter!
|
|
|
|
if($pbot->factoids->{factoidmodulelauncher}->{child} != 0) {
|
|
|
|
# if this process is a child, it must die now
|
2010-03-23 04:09:03 +01:00
|
|
|
$pbot->logger->log("Terminating module.\n");
|
|
|
|
exit 0;
|
2010-03-22 08:33:44 +01:00
|
|
|
}
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
sub interpret {
|
|
|
|
my $self = shift;
|
2012-08-24 00:50:07 +02:00
|
|
|
my ($from, $nick, $user, $host, $count, $command, $tonick) = @_;
|
|
|
|
my ($keyword, $arguments) = ("", "");
|
2010-03-17 07:36:54 +01:00
|
|
|
my $text;
|
2010-03-22 08:33:44 +01:00
|
|
|
my $pbot = $self->pbot;
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->logger->log("=== Enter interpret_command: [" . (defined $from ? $from : "(undef)") . "][$nick!$user\@$host][$count][$command]\n");
|
2010-03-17 07:36:54 +01:00
|
|
|
|
|
|
|
return "Too many levels of recursion, aborted." if(++$count > 5);
|
|
|
|
|
|
|
|
if(not defined $nick || not defined $user || not defined $host ||
|
|
|
|
not defined $command) {
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->logger->log("Error 1, bad parameters to interpret_command\n");
|
|
|
|
return undef;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
if($command =~ /^tell\s+(.{1,20})\s+about\s+(.*?)\s+(.*)$/i)
|
|
|
|
{
|
|
|
|
($keyword, $arguments, $tonick) = ($2, $3, $1);
|
2012-09-06 12:09:44 +02:00
|
|
|
} elsif($command =~ /^tell\s+(.{1,20})\s+about\s+(.*)$/i) {
|
2010-03-17 07:36:54 +01:00
|
|
|
($keyword, $tonick) = ($2, $1);
|
2012-09-06 12:09:44 +02:00
|
|
|
} elsif($command =~ /^([^ ]+)\s+is\s+also\s+(.*)$/i) {
|
2010-05-13 21:45:52 +02:00
|
|
|
($keyword, $arguments) = ("change", "$1 s|\$| - $2|");
|
2012-09-06 12:09:44 +02:00
|
|
|
} elsif($command =~ /^([^ ]+)\s+is\s+(.*)$/i) {
|
2010-06-20 08:16:48 +02:00
|
|
|
my ($k, $a) = ($1, $2);
|
2010-06-21 05:19:41 +02:00
|
|
|
|
2012-07-22 21:22:30 +02:00
|
|
|
$self->{pbot}->logger->log("calling find_factoid in Interpreter.pm, interpret() for factadd\n");
|
|
|
|
my ($channel, $trigger) = $pbot->factoids->find_factoid($from, $k, $a, 1);
|
2010-06-21 15:28:54 +02:00
|
|
|
|
2010-06-21 05:19:41 +02:00
|
|
|
if(defined $trigger) {
|
2010-06-20 08:16:48 +02:00
|
|
|
($keyword, $arguments) = ($k, "is $a");
|
|
|
|
} else {
|
2010-06-29 07:48:46 +02:00
|
|
|
($keyword, $arguments) = ("factadd", (defined $from ? $from : '.*' ) . " $k is $a");
|
2010-06-20 08:16:48 +02:00
|
|
|
}
|
2010-03-17 07:36:54 +01:00
|
|
|
} elsif($command =~ /^(.*?)\s+(.*)$/) {
|
|
|
|
($keyword, $arguments) = ($1, $2);
|
|
|
|
} else {
|
2012-08-24 00:50:07 +02:00
|
|
|
$keyword = $command;
|
|
|
|
}
|
|
|
|
|
|
|
|
if($keyword ne "factadd" and $keyword ne "add" and $keyword ne "msg") {
|
|
|
|
$keyword =~ s/(\w+)([?!.]+)$/$1/;
|
|
|
|
$arguments =~ s/(\w+)([?!.]+)$/$1/;
|
|
|
|
$arguments =~ s/(?<![\w\/\-])me\b/$nick/gi if defined $arguments;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
2010-06-19 19:37:16 +02:00
|
|
|
if(defined $arguments && $arguments =~ m/^(your|him|her|its|it|them|their)(self|selves)$/i) {
|
2010-03-17 07:36:54 +01:00
|
|
|
return "Why would I want to do that to myself?";
|
|
|
|
}
|
|
|
|
|
|
|
|
if(not defined $keyword) {
|
2010-03-22 08:33:44 +01:00
|
|
|
$pbot->logger->log("Error 2, no keyword\n");
|
|
|
|
return undef;
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
return $self->SUPER::execute_all($from, $nick, $user, $host, $count, $keyword, $arguments, $tonick);
|
|
|
|
}
|
2010-03-17 07:36:54 +01:00
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
sub pbot {
|
|
|
|
my $self = shift;
|
|
|
|
if(@_) { $self->{pbot} = shift; }
|
|
|
|
return $self->{pbot};
|
2010-03-17 07:36:54 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
1;
|