Perlbot/perlbuut
1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 10:35:41 -04:00
Code Issues Releases Wiki Activity

plugin adjustments. add pb and nl eval postfixes

Browse source
This commit is contained in:
Ryan Voots 2019-05-06 20:27:34 -04:00
parent 99bb46073e
commit 8bfea58ade
4 changed files with 53 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
plugins/compose.pm
View file

@ -27,7 +27,7 @@ sub command {
sub compose {
my($said, $pm) = @_;
my $str = decode 'utf8', $said->{body};
my $str = eval {decode 'utf8', $said->{body}} // $said->{body};
$said->{recursion} = 50 unless defined $said->{recursion};
$str =~ /\A\s*((\S).*(\S))\s*\z/s or
@ -94,7 +94,7 @@ sub runplugin {
my $plugin = $pm->get_plugin( $cmd, $said )
or return( 0, "Compose failed to find a plugin named: $cmd" );
local $said->{body} = encode 'utf8', $body;
local $said->{body} = $body;
local $said->{recommended_args} = [ split /\s+/, $body ];
local $said->{command_match} = $cmd;

10
plugins/factoids.pm
View file

@ -5,6 +5,7 @@ use DBD::SQLite::BundledExtensions;
use IRC::Utils qw/lc_irc strip_color strip_formatting/;
use Text::Metaphone;
use strict;
use Encode qw/decode/;
use Data::Dumper;
@ -760,7 +761,7 @@ sub _db_get_fact {
sub basic_get_fact {
my( $self, $pm, $said, $subject, $name, $call_only ) = @_;
# open(my $fh, ">>/tmp/facts");
# open(my $fh, ">>/tmp/facts");
my ($fact, $key, $arg);
$key = _clean_subject($subject);
@ -790,9 +791,12 @@ sub basic_get_fact {
print $fh Dumper($said, $plugin, $pm);
my $ret = $plugin->command($said, $pm);
# use Data::Dumper;
# print $fh Dumper({key => $key, arg => $arg, fact => $fact, ret => $ret, wa => wantarray});
use Data::Dumper;
print $fh Dumper({key => $key, arg => $arg, fact => $fact, ret => $ret});
# $ret = "die 'fuck me silly';";
# $ret = unpack("H*", decode('utf8',$ret));
$ret = "\x00$ret" if ($key eq "tell");
return $ret;

5
plugins/more.pm
View file

@ -54,8 +54,11 @@ sub post_process {
my $ua = LWP::UserAgent->new();
my $text = $$output_ref;
$text =~ s/\x{2424}/\n/g;
my $res = $ua->post("https://perl.bot/api/v1/paste", {
paste => $$output_ref,
paste => $text,
description => 'More text for '.$said->{body},
username => $said->{nick},
language => 'text'

45
plugins/supereval.pm
View file

@ -19,6 +19,28 @@ sub make_pastebin {
my $ua = LWP::UserAgent->new();
my $res = $ua->post("https://perl.bot/api/v1/paste", {
paste => $input,
description => 'Eval output for '.$who,
username => $who,
language => 'text'
});
if ($res->is_success()) {
my $content = $res->decoded_content;
my $data = decode_json $content;
return "Output at: ".$data->{url};
} else {
return "Couldn't pastebin output";
}
}
sub make_pastebin_all {
my ($who, $input) = @_;
my $ua = LWP::UserAgent->new();
my $res = $ua->post("https://perl.bot/api/v1/paste", {
paste => $input,
description => 'Evalall output for '.$who,
@ -49,7 +71,7 @@ sub new {
my @perl_aliases = map {("eval$_", "weval$_", "seval$_", "wseval$_", "sweval$_", "meval$_")} @versions;
$self->{aliases} = [ qw/jseval rkeval jeval phpeval pleval perleval deparse swdeparse wsdeparse wdeparse sdeparse k20eval rbeval pyeval luaeval cpeval wscpeval swcpeval wcpeval scpeval bleval coboleval cbeval basheval/, @perl_aliases ];
$self->{aliases} = [ map {$_, "${_}nl", "${_}pb"} qw/jseval rkeval r jeval phpeval pleval perleval deparse swdeparse wsdeparse wdeparse sdeparse k20eval rbeval pyeval luaeval cpeval wscpeval swcpeval wcpeval scpeval bleval coboleval cbeval basheval/, @perl_aliases ];
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db");
return $self;
@ -62,7 +84,10 @@ sub command {
my $command = $said->{command_match};
my $type = $said->{command_match};
$type =~ s/^\s*(\w+?)?eval(.*)?/$1$2/;
my ($postflags) = ($type =~ /((?:nl|pb)+)$/i);
my $nlflag = ($postflags =~ /nl/i);
my $pbflag = ($postflags =~ /pb/i);
$type =~ s/^\s*(\w+?)?eval(.*?)?\Q$postflags/$1$2/i;
warn "Initial type: $type\n";
my %translations = (
@ -94,6 +119,7 @@ sub command {
'wcp' => 'cperl',
'scp' => 'cperl',
'rk' => 'perl6',
'r' => 'perl6',
'bl' => 'perl',
'cb' => 'cobol',
'cobol' => 'cobol',
@ -136,10 +162,13 @@ sub command {
my $resultstr='';
unless ($type =~ /perlall/) {
$resultstr = $self->do_singleeval($type, $code);
if ($type =~ /perlall/) {
$resultstr = make_pastebin_all($said->{channel}, $code);
} elsif ($pbflag) {
my $output = $self->do_singleeval($type, $code);
$resultstr = make_pastebin($said->{channel}, $output);
} else {
$resultstr = make_pastebin($said->{channel}, $code);
$resultstr = $self->do_singleeval($type, $code);
}
# clean up the output of @INC and friends.
@ -153,6 +182,12 @@ sub command {
$resultstr = IRC::FromANSI::Tiny::convert($resultstr);
}
my $usenl = ($nlflag && !($type eq 'perl6' || $type eq 'bash')) ||
(!$nlflag && ($type eq 'perl6' || $type eq 'bash'));
if ($usenl) {
$resultstr =~ s/\n/\x{2424}/g;
}
$resultstr =~ s/^(\x00)+//g;