--- loncom/xml/run.pm 2000/06/29 18:53:24 1.4 +++ loncom/xml/run.pm 2001/01/04 19:14:10 1.14 @@ -1,19 +1,69 @@ package Apache::run; -sub evaluate { +sub evaluateold { 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.');'); - $safeeval->reval('$_=\''.$expression.'\';'); - $safeeval->reval('{'.$decls.'$_=~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]*\}))([\[\{][^\$\&\]\}]+[\]\}])*?(\([^\$\&\)]+\))*?(?=[^\[\{\(]|$)/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($@); + } + if ( $#result < '1') { + return $result[0]; + } else { + &Apache::lonxml::debug("Got lots results:$#result:"); + return (@result); + } } 1;