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

Support more perl versions

Browse source
This commit is contained in:
Ryan Voots 2017-04-01 15:12:48 -04:00
parent 37bf69825a
commit 0900baaa31
2 changed files with 32 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lib/eval.pl
View file

@ -309,7 +309,7 @@ use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on dem
# Setup SECCOMP for us # Setup SECCOMP for us
get_seccomp(); get_seccomp();
$code =~ s/^\s*(\w+)\s*// $code =~ s/^\s*(\S+)\s*//
or die "Failed to parse code type! $code"; or die "Failed to parse code type! $code";
my $type = $1; my $type = $1;
@ -324,6 +324,9 @@ get_seccomp();
elsif( $type eq 'deparse' ) { elsif( $type eq 'deparse' ) {
deparse_perl_code($code); deparse_perl_code($code);
} }
elsif ($type =~ /perl([0-9.]+)/) { # run specific perl version
perl_version_code($1, $code);
}
# elsif( $type eq 'javascript' ) { # elsif( $type eq 'javascript' ) {
# javascript_code($code); # javascript_code($code);
# } # }
@ -397,7 +400,22 @@ Biqsip biqsip 'ugh chan ghitlh lursa' nuh bey' ngun petaq qeng soj tlhej waqboch
if( $@ ) { print "ERROR: $@" } if( $@ ) { print "ERROR: $@" }
} }
sub perl_version_code {
my ($version, $code) = @_;
my %vmap = (
'5.10' => '/perl5/perlbrew/perls/perl-5.10.1/bin/perl',
'5.12' => '/perl5/perlbrew/perls/perl-5.12.5/bin/perl',
'5.14' => '/perl5/perlbrew/perls/perl-5.14.4/bin/perl',
'5.16' => '/perl5/perlbrew/perls/perl-5.16.3/bin/perl',
'5.18' => '/perl5/perlbrew/perls/perl-5.18.4/bin/perl',
'5.20' => '/perl5/perlbrew/perls/perl-5.20.3/bin/perl',
'5.22' => '/perl5/perlbrew/perls/perl-5.22.3/bin/perl',
'5.24' => '/perl5/perlbrew/perls/perl-5.24.0/bin/perl',
);
exec($vmap{$version}, '-e', $code);
}
# sub javascript_code { # sub javascript_code {
# my( $code ) = @_; # my( $code ) = @_;

17
plugins/eval.pm
View file

@ -19,7 +19,11 @@ sub new {
$self->{opts} = { $self->{opts} = {
command => 1, command => 1,
}; };
$self->{aliases} = [ qw/jseval jeval phpeval pleval perleval deparse k20eval rbeval pyeval luaeval weval wseval sweval seval/ ];
my @versions = ('', qw(5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24));
my @perl_aliases = map {("eval$_", "weval$_", "seval$_", "wseval$_", "sweval$_")} @versions;
$self->{aliases} = [ qw/jseval jeval phpeval pleval perleval deparse k20eval rbeval pyeval luaeval/, @perl_aliases ];
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db"); $self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db");
return $self; return $self;
@ -33,9 +37,12 @@ sub command {
my $command = $said->{command_match}; my $command = $said->{command_match};
my $type = $said->{command_match}; my $type = $said->{command_match};
$type =~ s/^\s*(\w+?)eval/$1/; $type =~ s/^\s*(\w+?)?eval(.*)?/$1$2/;
warn "Initial type: $type\n"; warn "Initial type: $type\n";
my %translations = (
my @versions = ('', qw(5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24));
my %translations = (
js => 'javascript', js => 'javascript',
perl => 'perl', perl => 'perl',
pl => 'perl', pl => 'perl',
@ -53,8 +60,10 @@ sub command {
's' => 'perl', 's' => 'perl',
'ws' => 'perl', 'ws' => 'perl',
'sw' => 'perl', 'sw' => 'perl',
map {($_=>"perl$_", "w$_"=>"perl$_", "s$_" => "perl$_", "ws$_"=>"perl$_", "sw$_"=>"perl$_")} @versions
); );
my $orig_type = $type;
$type = $translations{$type}; $type = $translations{$type};
if( not $type ) { $type = 'perl'; } if( not $type ) { $type = 'perl'; }
warn "Found $type: $code"; warn "Found $type: $code";
@ -99,7 +108,7 @@ sub command {
$resultstr .= " I'm back!" $resultstr .= " I'm back!"
} }
return( 'handled', $resultstr ); return( 'handled', $resultstr);
} }
"Bot::BB3::Plugin::Eval"; "Bot::BB3::Plugin::Eval";