--- loncom/xml/run.pm 2002/02/15 21:33:12 1.23
+++ loncom/xml/run.pm 2002/05/23 21:15:34 1.29
@@ -1,6 +1,6 @@
package Apache::run;
#
-# $Id: run.pm,v 1.23 2002/02/15 21:33:12 albertel Exp $
+# $Id: run.pm,v 1.29 2002/05/23 21:15:34 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,33 +25,15 @@ package Apache::run;
# http://www.lon-capa.org/
#
-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 ''; }
- 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:$@:");
- }
- return $result
-}
+use HTML::Entities;
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE';
- my %oldexpressions=();
- while (!$oldexpressions{$_}) {
- $oldexpressions{$_}=1;
+ my %_LONCAPA_INTERNAL_oldexpressions=();
+ my $i=0;
+ while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) {
+ $_LONCAPA_INTERNAL_oldexpressions{$_}=1;
$_ =~s/((?:\$|\&)(?:[\#|\$]*[A-Za-z][\w]*|\{[A-Za-z][\w]*\}))([\[\{][^\$\&\]\}]+[\]\}])*?(\([^\$\&\)]+\))*?(?=[^\[\{\(]|$)/eval(defined(eval($1.$2))?eval('$1.$2.$3'):'$1.$2.$3')/seg;
+ if ($i++ > 10 ) { last; }
}
ENDEVALUATE
@@ -61,14 +43,21 @@ sub evaluate {
if (!$Apache::lonxml::evaluate) { return $expression; }
my $result = '';
$@='';
+ if ($Apache::lonxml::request) {
+ $Apache::lonxml::request->hard_timeout("Apache::run::run, evaluation $code");
+ }
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression.
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}');
+ if ($Apache::lonxml::request) { $Apache::lonxml::request->kill_timeout; }
# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}');
+ my $error=$@;
if ($@ eq '') {
$result = $safeeval->reval('return $_;');
chomp $result;
} else {
- &Apache::lonxml::error("substitution on:$expression:with:$decls:caused $@");
+ &Apache::lonxml::error('substitution on
'.$expression. + 'with
'.$decls. + 'caused
'.$error); } return $result } @@ -77,9 +66,16 @@ sub run { my ($code,$safeeval,$hideerrors) = @_; # print "inside run\n"; $@=''; + if ($Apache::lonxml::request) { + $Apache::lonxml::request->hard_timeout("Apache::run::run, evaluation $code"); + } my (@result)=$safeeval->reval($code); - if ($@ ne '' && !$hideerrors) { - &Apache::lonxml::error(":$@: occured while running :$code:"); + if ($Apache::lonxml::request) { $Apache::lonxml::request->kill_timeout; } + my $error=$@; + if ($error ne '' && !$hideerrors) { + &Apache::lonxml::error(''.&HTML::Entities::encode($error). + 'occured while running'. + &HTML::Entities::encode($code).''); } if ( $#result < '1') { return $result[0]; @@ -94,19 +90,21 @@ sub dump { my $dump=''; foreach my $symname (sort keys %{$safeeval->varglob('main::')}) { if (($symname!~/^\_/) && ($symname!~/\:$/)) { + my $line; if ($safeeval->reval('defined($'.$symname.')')) { - $dump.='$'.$symname.'='.$safeeval->reval('$'.$symname)."\n"; + $line='$'.$symname.'='.$safeeval->reval('$'.$symname); } if ($safeeval->reval('defined(@'.$symname.')')) { - $dump.='@'.$symname.'=('. - $safeeval->reval('join(",",@'.$symname.')').")\n"; + $line='@'.$symname.'=('. + $safeeval->reval('join(",",@'.$symname.')').")"; } if ($safeeval->reval('defined(%'.$symname.')')) { - $dump.='%'.$symname.'=('; - $dump.=$safeeval->reval('join(",",map { $_."=>".$'. + $line='%'.$symname.'=('; + $line.=$safeeval->reval('join(",",map { $_."=>".$'. $symname.'{$_} } sort keys %'. - $symname.')').")\n"; + $symname.')').")" } + if ($line ne '') { $dump.=&HTML::Entities::encode($line)."
\n"; } } } $dump.='';