version 1.29, 2002/05/23 21:15:34
|
version 1.32, 2003/03/24 22:43:31
|
Line 29 use HTML::Entities;
|
Line 29 use HTML::Entities;
|
|
|
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; |
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; |
my %_LONCAPA_INTERNAL_oldexpressions=(); |
my %_LONCAPA_INTERNAL_oldexpressions=(); |
my $i=0; |
|
while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) { |
while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) { |
$_LONCAPA_INTERNAL_oldexpressions{$_}=1; |
$_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; |
$_ =~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; } |
if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;} |
} |
} |
ENDEVALUATE |
ENDEVALUATE |
|
|
sub evaluate { |
sub evaluate { |
my ($expression,$safeeval,$decls) = @_; |
my ($expression,$safeeval,$decls) = @_; |
unless (defined($expression)) { return ''; } |
unless (defined($expression)) { return ''; } |
if (!$Apache::lonxml::evaluate) { return $expression; } |
if ($Apache::lonxml::evaluate < 1) { return $expression; } |
my $result = ''; |
my $result = ''; |
$@=''; |
$@=''; |
if ($Apache::lonxml::request) { |
$Apache::run::timeout=0; |
$Apache::lonxml::request->hard_timeout("Apache::run::run, evaluation $code"); |
$main::SIG{'ALRM'} = sub { |
} |
$Apache::run::timeout=1; |
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. |
Apache->request->print("timeout<br /> \n"); |
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); |
}; |
if ($Apache::lonxml::request) { $Apache::lonxml::request->kill_timeout; } |
eval { |
# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}'); |
alarm(Apache->request->server->timeout); |
my $error=$@; |
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. |
if ($@ eq '') { |
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); |
$result = $safeeval->reval('return $_;'); |
alarm(0); |
chomp $result; |
}; |
} else { |
my $error=$@; |
&Apache::lonxml::error('substitution on <pre>'.$expression. |
if ($error eq '' && !$Apache::run::timeout) { |
'</pre> with <pre>'.$decls. |
$result = $safeeval->reval('return $_;'); |
'</pre> caused <pre>'.$error); |
chomp $result; |
} |
} else { |
return $result |
if ($Apache::run::timeout) { |
|
$error = 'Code ran too long. It ran for more than '. |
|
Apache->request->server->timeout.' seconds'; |
|
} |
|
&Apache::lonxml::error('substitution on <pre>'.$expression. |
|
'</pre> with <pre>'.$decls. |
|
'</pre> caused <pre>'.$error); |
|
} |
|
return $result |
} |
} |
|
|
sub run { |
sub run { |
my ($code,$safeeval,$hideerrors) = @_; |
my ($code,$safeeval,$hideerrors) = @_; |
# print "inside run\n"; |
my @result; |
$@=''; |
$@=''; |
if ($Apache::lonxml::request) { |
$Apache::run::timeout=0; |
$Apache::lonxml::request->hard_timeout("Apache::run::run, evaluation $code"); |
$main::SIG{'ALRM'} = sub { |
} |
$Apache::run::timeout=1; |
my (@result)=$safeeval->reval($code); |
Apache->request->print("timeout<br /> \n"); |
if ($Apache::lonxml::request) { $Apache::lonxml::request->kill_timeout; } |
}; |
my $error=$@; |
eval { |
if ($error ne '' && !$hideerrors) { |
alarm(Apache->request->server->timeout); |
&Apache::lonxml::error('<pre>'.&HTML::Entities::encode($error). |
@result=$safeeval->reval($code); |
'</pre> occured while running <pre>'. |
alarm(0); |
&HTML::Entities::encode($code).'</pre>'); |
}; |
} |
my $error=$@; |
if ( $#result < '1') { |
if (($Apache::run::timeout || $error ne '') && !$hideerrors) { |
return $result[0]; |
if ($Apache::run::timeout) { |
} else { |
$error = 'Code ran too long. It ran for more than '. |
&Apache::lonxml::debug("<b>Got lots results</b>:$#result:"); |
Apache->request->server->timeout.' seconds'; |
return (@result); |
} |
} |
&Apache::lonxml::error('<pre>'.&HTML::Entities::encode($error). |
|
'</pre> occured while running <pre>'. |
|
&HTML::Entities::encode($code).'</pre>'); |
|
} |
|
if ( $#result < '1') { |
|
return $result[0]; |
|
} else { |
|
&Apache::lonxml::debug("<b>Got lots results</b>:$#result:"); |
|
return (@result); |
|
} |
} |
} |
|
|
sub dump { |
sub dump { |