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

Getting ready for writable /tmp

Browse source
This commit is contained in:
Ryan Voots 2017-05-04 21:57:11 -04:00
parent b18cb6550c
commit 58bc1e7e56
3 changed files with 24 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
bin/testeval.sh
View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
read -r -d '' CODE <<'EOC' read -r -d '' CODE <<'EOC'
ruby print "Hello World" perl BEGIN {$ENV{TMPDIR}="/tmp"}; use File::Temp; File::Temp->new()."";
EOC EOC
echo -------- echo --------

1
cpanfile
View file

@ -96,3 +96,4 @@ requires 'Text::Metaphone' => 0;
requires 'Math::Round' => 0; requires 'Math::Round' => 0;
requires 'Twitter::API' => 0; requires 'Twitter::API' => 0;
requires 'Types::Standard' => 0; requires 'Types::Standard' => 0;
requires 'Perl::Tidy' => 0;

31
lib/eval.pl
View file

@ -24,25 +24,26 @@ do {
package Zathras; package Zathras;
our $AUTOLOAD; our $AUTOLOAD;
use overload '""' => sub { use overload '""' => sub {
my $data = "'".$_[0]{data}."'"; my $data = @{$_[0]{args}}? qq{$_[0]{data}(}.join(', ', map {"".$_} @{$_[0]{args}}).qq{)} : qq{$_[0]{data}};
my $old = $_[0]{old}; my $old = $_[0]{old};
my ($pack, undef, undef, $meth) = caller(1); my ($pack, undef, undef, $meth) = caller(1);
if ($pack eq 'Zathras' && $meth ne 'Zahtras::dd_freeze') { if ($pack eq 'Zathras' && $meth ne 'Zahtras::dd_freeze') {
if (ref($old) ne 'Zathras') { if (ref($old) ne 'Zathras') {
return " and $data"; return "Zathras->$data";
} else { } else {
return ", $data$old"; return "${old}->$data";
} }
} else { } else {
$old = "" if (!ref($old)); $old = "" if (!ref($old));
return "Everybody come to Zathras for $data$old. Zathras not mind." return "$old->$data"
} }
}; };
sub AUTOLOAD {$AUTOLOAD=~s/.*:://; bless {data=>$AUTOLOAD, old => shift}} sub AUTOLOAD {$AUTOLOAD=~s/.*:://; bless {data=>$AUTOLOAD, args => \@_, old => shift}}
sub DESTROY {}; # keep it from recursing sub DESTROY {}; # keep it from recursing
sub dd_freeze {$_[0]=\($_[0]."")} sub dd_freeze {$_[0]=\($_[0]."")}
sub can {my ($self, $meth) = @_; return sub{$self->$meth(@_)}}
}; };
# save the old stdout, we're going to clobber it soon. STDOUT # save the old stdout, we're going to clobber it soon. STDOUT
@ -235,7 +236,19 @@ no warnings;
$ret = $clean_out->($ret); $ret = $clean_out->($ret);
push @out, $ret; push @out, $ret;
print STDOUT join(' ', @out); my $fullout = join(' ', @out);
use Perl::Tidy;
my $hide = do {package hiderr; sub print{}; bless {}};
my $tidy_out="";
eval {
my $foo = "$fullout";
Perl::Tidy::perltidy(source => \$foo, destination => \$tidy_out, errorfile => $hide, logfile => $hide);
};
$tidy_out = $fullout if ($@);
print STDOUT $tidy_out;
} }
eval "use utf8; \$\343\201\257 = 42; 'ש' =~ /([\p{Bidi_Class:L}\p{Bidi_Class:R}])/"; # attempt to automatically load the utf8 libraries. eval "use utf8; \$\343\201\257 = 42; 'ש' =~ /([\p{Bidi_Class:L}\p{Bidi_Class:R}])/"; # attempt to automatically load the utf8 libraries.
@ -465,15 +478,15 @@ Biqsip biqsip 'ugh chan ghitlh lursa' nuh bey' ngun petaq qeng soj tlhej waqboch
my $ret; my $ret;
my @os = qw/aix bsdos darwin dynixptx freebsd haiku linux hpux irix next openbsd dec_osf svr4 sco_sv unicos unicosmk solaris sunos MSWin32 MSWin16 MSWin63 dos os2 cygwin VMS vos os390 os400 posix-bc riscos amigaos xenix/; my @os = qw/aix bsdos darwin dynixptx freebsd haiku linux hpux irix next openbsd dec_osf svr4 sco_sv unicos unicosmk solaris sunos MSWin32 MSWin16 MSWin63 dos os2 cygwin vos os390 os400 posix-bc riscos amigaos xenix/;
{ {
local $^O = $os[rand()*@os]; # local $^O = $os[rand()*@os];
no strict; no warnings; package main; no strict; no warnings; package main;
# my $oldout; # my $oldout;
do { do {
local $/="\n"; local $/="\n";
local $\="\n"; local $\;
local $,; local $,;
$code = "use $]; use feature qw/postderef refaliasing lexical_subs postderef_qq signatures/; use experimental 'declared_refs';\n#line 1 \"(IRC)\"\n$code"; $code = "use $]; use feature qw/postderef refaliasing lexical_subs postderef_qq signatures/; use experimental 'declared_refs';\n#line 1 \"(IRC)\"\n$code";
$ret = eval $code; $ret = eval $code;