--- loncom/xml/run.pm 2000/10/02 22:20:18 1.7
+++ 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('$_=\''.$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;