--- loncom/xml/run.pm 2000/06/29 20:27:44 1.5 +++ loncom/xml/run.pm 2000/10/30 20:05:19 1.9 @@ -2,19 +2,37 @@ package Apache::run; sub evaluate { my ($expression,$safeeval,$decls) = @_; -# print "inside2 evaluate with $expression\n"; +# print "inside2 evaluate $decls with $expression
\n"; # gerd's old method interpolates unset vars # $safeeval->reval('return qq('.$expression.');'); unless (defined $expression) { return ''; } - $safeeval->reval('$_=\''.$expression.'\';'); - $safeeval->reval('{'.$decls.'$_=~s/(\$\{?[A-Za-z]\w*\}?)/(defined(eval($1))?eval($1):$1)/ge;}'); - $safeeval->reval('return $_;'); + my $result = ''; + $@=''; + $safeeval->reval('$_=q|'.$expression.'|;'); + if ($@ eq '') { + $safeeval->reval('{'.$decls.'$_=~s/(\$[A-Za-z]\w*)/(defined(eval($1))?eval($1):$1)/ge;}'); + if ($@ eq '') { + $result = $safeeval->reval('return $_;'); + } else { + &Apache::lonxml::error("substituion on:$expression:with:$decls:caused"); + } + } else { + &Apache::lonxml::error("defining:$expression:caused"); + } + if ($@ ne '') {&Apache::lonxml::error($@);} + return $result } sub run { my ($code,$safeeval) = @_; # print "inside run\n"; - $safeeval->reval($code); + $@=''; + my $result=$safeeval->reval($code); + if ($@ ne '') { + &Apache::lonxml::error(":$code:caused"); + &Apache::lonxml::error($@); + } + return $result; } 1;