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

make deparse smarter

Browse source
This commit is contained in:
Ryan Voots 2017-04-05 20:41:48 -04:00
parent 923b2f270f
commit c954380c04
1 changed files with 39 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
lib/eval.pl
View file

@ -169,25 +169,47 @@ no warnings;
# deparse output being much longer than it should be.
sub deparse_perl_code {
my( $code ) = @_;
my $sub;
{
no strict; no warnings; no charnames;
$sub = eval "use $]; sub{ $code\n }";
}
if( $@ ) { print STDOUT "Error: $@"; return }
my $sub;
{
no strict; no warnings; no charnames;
$sub = eval "use $]; package botdeparse; sub{ $code\n }";
}
my $dp = B::Deparse->new("-p", "-q", "-x7");
my $ret = $dp->coderef2text($sub);
my %methods = (map {$_ => botdeparse->can($_)} grep {botdeparse->can($_)} keys {%botdeparse::}->%*);
$ret =~ s/\{//;
$ret =~ s/package (?:\w+(?:::)?)+;//;
$ret =~ s/ no warnings;//;
$ret =~ s/\s+/ /g;
$ret =~ s/\s*\}\s*$//;
$ret =~ s/\s*\$\^H\{[^}]+\}(\s+=\s+[^;]+;?)?\s*//g;
$ret =~ s/\s*BEGIN\s*\{\s*[^}]*\s*\}\s*/ /;
if( $@ ) { print STDOUT "Error: $@"; return }
print STDOUT $ret;
my $dp = B::Deparse->new("-p", "-q", "-x7");
my @out;
my $clean_out = sub {
my $ret = shift;
$ret =~ s/\{//;
$ret =~ s/package (?:\w+(?:::)?)+;//;
$ret =~ s/no warnings;//;
$ret =~ s/\s+/ /g;
$ret =~ s/\s*\}\s*$//;
$ret =~ s/\s*\$\^H\{[^}]+\}(\s+=\s+[^;]+;?)?\s*//g;
$ret =~ s/\s*BEGIN\s*\{\s*[^}]*\s*\}\s*/ /;
$ret =~ s/package botdeparse;//;
$ret =~ s/no feature ':all';//;
$ret =~ s/use feature [^;]+;//;
$ret =~ s/^\s+|\s+$//g;
return $ret;
};
for my $sub (keys %methods) {
my $ret = $clean_out->($dp->coderef2text($methods{$sub}));
push @out, "sub $sub {$ret} ";
}
my $ret = $dp->coderef2text($sub);
$ret = $clean_out->($ret);
push @out, $ret;
print STDOUT join(' ', @out);
}
eval "use utf8; \$\343\201\257 = 42; 'ש' =~ /([\p{Bidi_Class:L}\p{Bidi_Class:R}])/"; # attempt to automatically load the utf8 libraries.
@ -201,7 +223,7 @@ use Text::ParseWords;
eval {"\N{SPARKLE}"}; # force loading of some of the charnames stuff
# Required for perl_deparse
use B::Deparse;
use B::RecDeparse;
## Javascript Libs
#BEGIN{ eval "use JavaScript::V8; require JSON::XS; JavaScript::V8::Context->new()->eval('1')"; }