diff options
Diffstat (limited to 'ext/Opcode')
-rw-r--r-- | ext/Opcode/Safe.pm | 36 |
1 files changed, 18 insertions, 18 deletions
diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm index 9b618f2f8f..7e1d6a34a7 100644 --- a/ext/Opcode/Safe.pm +++ b/ext/Opcode/Safe.pm @@ -152,6 +152,7 @@ sub share_from { my $pkg = shift; my $vars = shift; my $no_record = shift || 0; + my $root = $obj->root(); croak("vars not an array ref") unless ref $vars eq 'ARRAY'; no strict 'refs'; # Check that 'from' package actually exists @@ -166,16 +167,13 @@ sub share_from { my ($var, $type); $type = $1 if ($var = $arg) =~ s/^(\W)//; # warn "share_from $pkg $type $var"; - my $obj_to_share = (!$type) ? \&{$pkg."::$var"} + *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"} : ($type eq '&') ? \&{$pkg."::$var"} : ($type eq '$') ? \${$pkg."::$var"} : ($type eq '@') ? \@{$pkg."::$var"} : ($type eq '%') ? \%{$pkg."::$var"} : ($type eq '*') ? *{$pkg."::$var"} : croak(qq(Can't share "$type$var" of unknown type)); - package main; - Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, - sub { *$var = $obj_to_share }); } $obj->share_record($pkg, $vars) unless $no_record or !$vars; } @@ -210,25 +208,27 @@ sub varglob { sub reval { my ($obj, $expr, $strict) = @_; + my $root = $obj->{Root}; - package main; - if ($strict) { - use strict; - return Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, - sub { eval $expr }); - } - else { - no strict; - return Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, - sub { eval $expr }); - } + # Create anon sub ref in root of compartment. + # Uses a closure (on $expr) to pass in the code to be executed. + # (eval on one line to keep line numbers as expected by caller) + my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); + my $evalsub; + + if ($strict) { use strict; $evalsub = eval $evalcode; } + else { no strict; $evalsub = eval $evalcode; } + + return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } sub rdo { my ($obj, $file) = @_; - package main; - return Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, - sub { do $file }); + my $root = $obj->{Root}; + + my $evalsub = eval + sprintf('package %s; sub { do $file }', $root); + return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } |