version 1.4, 2000/06/29 18:53:24
|
version 1.13, 2000/11/20 17:34:05
|
Line 1
|
Line 1
|
package Apache::run; |
package Apache::run; |
|
|
sub evaluate { |
sub evaluateold { |
my ($expression,$safeeval,$decls) = @_; |
my ($expression,$safeeval,$decls) = @_; |
# print "inside2 evaluate with $expression\n"; |
# print "inside2 evaluate $decls with $expression<br>\n"; |
# gerd's old method interpolates unset vars |
# gerd's old method interpolates unset vars |
# $safeeval->reval('return qq('.$expression.');'); |
# $safeeval->reval('return qq('.$expression.');'); |
$safeeval->reval('$_=\''.$expression.'\';'); |
unless (defined $expression) { return ''; } |
$safeeval->reval('{'.$decls.'$_=~s/(\$\{?[A-Za-z]\w*\}?)/(defined(eval($1))?eval($1):$1)/ge;}'); |
my $result = ''; |
$safeeval->reval('return $_;'); |
$@=''; |
|
$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 { |
sub run { |
my ($code,$safeeval) = @_; |
my ($code,$safeeval) = @_; |
# print "inside run\n"; |
# 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; |
1; |