--- loncom/xml/run.pm 2000/10/11 13:33:33 1.8 +++ loncom/xml/run.pm 2001/01/04 19:14:10 1.14 @@ -1,6 +1,6 @@ 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 @@ -8,13 +8,13 @@ sub evaluate { unless (defined $expression) { return ''; } my $result = ''; $@=''; - $safeeval->reval('$_=q{'.$expression.'};'); + $safeeval->reval('$_=q|'.$expression.'|;'); if ($@ eq '') { - $safeeval->reval('{'.$decls.'$_=~s/(\$\{?[A-Za-z]\w*\}?)/(defined(eval($1))?eval($1):$1)/ge;}'); + $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"); + &Apache::lonxml::error("substitution on:$expression:with:$decls:caused"); } } else { &Apache::lonxml::error("defining:$expression:caused"); @@ -23,16 +23,47 @@ sub evaluate { 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"; $@=''; - my $result=$safeeval->reval($code); + my (@result)=$safeeval->reval($code); if ($@ ne '') { &Apache::lonxml::error(":$code:caused"); &Apache::lonxml::error($@); } - return $result; + if ( $#result < '1') { + return $result[0]; + } else { + &Apache::lonxml::debug("Got lots results:$#result:"); + return (@result); + } } 1;