--- loncom/xml/run.pm 2000/06/29 13:58:23 1.3 +++ loncom/xml/run.pm 2000/11/15 15:29:33 1.11 @@ -1,19 +1,63 @@ package Apache::run; -sub evaluate { - my ($expression,$safeeval) = @_; -# print "inside2 evaluate with $expression\n"; +sub evaluateold { + my ($expression,$safeeval,$decls) = @_; +# print "inside2 evaluate $decls with $expression
\n"; # gerd's old method interpolates unset vars -# $safeeval->reval('return qq('.$expression.');'); - $safeeval->reval('$_=\''.$expression.'\';'); - $safeeval->reval('$_=~s/(\$\{?[A-Za-z]\w*\}?)/(defined(eval($1))?eval($1):$1)/ge;'); - $safeeval->reval('return $_;'); +# $safeeval->reval('return qq('.$expression.');'); + unless (defined $expression) { 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("substitution on:$expression:with:$decls:caused"); + } + } else { + &Apache::lonxml::error("defining:$expression:caused"); + } + if ($@ ne '') {&Apache::lonxml::error($@);} + return $result +} + +$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; + my %oldexpressions=(); + while (!$oldexpressions{$_}) { + $oldexpressions{$_}=1; + $_ =~s/((?:\$|\&)(?:[\#|\$]*[A-Za-z][\w]*|\{[A-Za-z][\w]*\}))([\[|\{][\w\'\"]+[\]\}])*?(\([\w\'\"]+\))*?(?=[^\[\{\(]|$)/eval(defined(eval($1.$2))?eval('$1.$2.$3'):'$1.$2.$3')/seg; + } +ENDEVALUATE + +sub evaluate { + my ($expression,$safeeval,$decls) = @_; + unless (defined $expression) { return ''; } + my $result = ''; + $@=''; + print $decls + $safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. + "\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); +# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}'); + if ($@ eq '') { + $result = $safeeval->reval('return $_;'); + } else { + &Apache::lonxml::error("substitution on:$expression:with:$decls:caused $@"); + } + 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;