[LON-CAPA-cvs] cvs: loncom /xml Safe.pm

[albertel]

albertel		Fri Aug 29 23:25:34 2003 EDT

  Modified files:              
    /loncom/xml	Safe.pm 
  Log:
  - restoring bugfix from 1.5
  - fixes stupid bleed of variable names from the reval subroutine into the eval expression.
  
  
Index: loncom/xml/Safe.pm
diff -u loncom/xml/Safe.pm:1.6 loncom/xml/Safe.pm:1.7
--- loncom/xml/Safe.pm:1.6	Fri Aug 29 22:26:37 2003
+++ loncom/xml/Safe.pm	Fri Aug 29 23:25:34 2003
@@ -208,19 +208,20 @@
 
 
 sub reval {
-    my ($obj, $expr, $strict) = @_;
-    my $root = $obj->{Root};
-
-    # 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; }
+    $Safe::evalsub;
+    {
+	my ($obj, $expr, $strict) = @_;
+	my $root = $obj->{Root};
 
-    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+	# 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; }', $obj->{Root});
+	
+	if ($strict) { use strict; $Safe::evalsub = eval $evalcode; }
+	else         {  no strict; $Safe::evalsub = eval $evalcode; }
+    }
+    return Opcode::_safe_call_sv($_[0]->{Root}, $_[0]->{Mask}, $Safe::evalsub);
 }
 
 sub rdo {
@@ -228,7 +229,7 @@
     my $root = $obj->{Root};
 
     my $evalsub = eval
-	    sprintf('package %s; sub { @_ = (); do $file }', $root);
+	    sprintf('package %s; sub { @_ = (\'\'); do $file }', $root);
     return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
 }