--- loncom/xml/run.pm 2000/09/19 18:05:21 1.6 +++ loncom/xml/run.pm 2000/11/20 17:34:05 1.13 @@ -1,20 +1,64 @@ package Apache::run; -sub evaluate { +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.');'); 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("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]*\}))([\[\{][^\$\&\]\}]+[\]\}])*?(\([^\$\&\)]+\))*?(?=[^\[\{\(]|$)/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 $_;'); + chomp $result; + } 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;