Perlbot/perlbuut
1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-08 01:45:42 -04:00
Code Issues Releases Wiki Activity

Add basic evallall

Browse source
This commit is contained in:
Ryan Voots 2017-04-04 17:01:49 -04:00
parent 5f7d37b8f0
commit f3c423afea
1 changed files with 58 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
plugins/eval.pm
View file

@ -11,7 +11,7 @@ use strict;
no warnings 'void';
my @versions = ('', qw(4 5.5 5.6 5.8 5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24));
my @versions = ('', qw(4 5.5 5.6 5.8 5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24 all));
sub new {
my( $class ) = @_;
@ -34,7 +34,6 @@ sub command {
my( $self, $said, $pm ) = @_;
my $code = $said->{"body"};
my $dbh = $self->{dbh};
my $command = $said->{command_match};
my $type = $said->{command_match};
@ -75,6 +74,44 @@ sub command {
$code =~ s/␤/\n/g;
my $resultstr='';
unless ($type =~ /perlall/) {
$resultstr = $self->do_eval($type, $code);
} else {
my @outs;
# TODO use channel config for this
if ($said->{channel} eq '#perlbot' || $said->{channel} eq '*irc_msg') {
for my $version (@versions) {
my $torun = $version eq '' ? 'blead' : $version;
next if $version eq 'all';
next if $version eq '4';
push @outs, "[[$torun]]", $self->do_eval('perl'.$version, $code);
}
$resultstr = join " ", @outs;
} else {
$resultstr = "evalall only works in /msg or in #perlbot";
}
}
if (!$said->{captured} && $resultstr !~ /\S/) {
$resultstr = "No output.";
}
if ($type eq 'perl') {
$self->{dbh}->do("INSERT INTO evals (input, output) VALUES (?, ?)", {}, $code, $resultstr);
}
return( 'handled', $resultstr);
}
sub do_eval {
my ($self, $type, $code) = @_;
my $filter = POE::Filter::Reference->new();
my $socket = IO::Socket::INET->new( PeerAddr => 'localhost', PeerPort => '14400' )
or die "error: cannot connect to eval server";
@ -89,14 +126,6 @@ sub command {
my $result = $filter->get( [ $output ] );
my $resultstr = $result->[0]->[0];
if ($type eq 'perl') {
$dbh->do("INSERT INTO evals (input, output) VALUES (?, ?)", {}, $code, $resultstr);
}
if (!$said->{captured} && $resultstr !~ /\S/) {
$resultstr = "No output.";
}
$resultstr =~ s/\x0a?\x0d//g; # Prevent sending messages to the IRC server..
$resultstr = decode("utf8", $resultstr);
@ -107,7 +136,7 @@ sub command {
$resultstr .= " I'm back!"
}
return( 'handled', $resultstr);
return $resultstr;
}
"Bot::BB3::Plugin::Eval";