--- loncom/xml/run.pm 2002/05/24 16:48:50 1.30 +++ loncom/xml/run.pm 2003/03/24 22:43:31 1.32 @@ -1,6 +1,6 @@ package Apache::run; # -# $Id: run.pm,v 1.30 2002/05/24 16:48:50 albertel Exp $ +# $Id: run.pm,v 1.32 2003/03/24 22:43:31 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,51 +37,68 @@ $Apache::run::EVALUATE_STRING=<<'ENDEVAL ENDEVALUATE sub evaluate { - my ($expression,$safeeval,$decls) = @_; - unless (defined($expression)) { return ''; } - 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
'.$error); - } - return $result + my ($expression,$safeeval,$decls) = @_; + unless (defined($expression)) { return ''; } + if ($Apache::lonxml::evaluate < 1) { return $expression; } + my $result = ''; + $@=''; + $Apache::run::timeout=0; + $main::SIG{'ALRM'} = sub { + $Apache::run::timeout=1; + Apache->request->print("timeout
\n"); + }; + eval { + alarm(Apache->request->server->timeout); + $safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. + "\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); + alarm(0); + }; + my $error=$@; + if ($error eq '' && !$Apache::run::timeout) { + $result = $safeeval->reval('return $_;'); + chomp $result; + } else { + if ($Apache::run::timeout) { + $error = 'Code ran too long. It ran for more than '. + Apache->request->server->timeout.' seconds'; + } + &Apache::lonxml::error('substitution on'.$expression. + 'with'.$decls. + 'caused'.$error); + } + return $result } 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 ($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]; - } else { - &Apache::lonxml::debug("Got lots results:$#result:"); - return (@result); - } + my ($code,$safeeval,$hideerrors) = @_; + my @result; + $@=''; + $Apache::run::timeout=0; + $main::SIG{'ALRM'} = sub { + $Apache::run::timeout=1; + Apache->request->print("timeout
\n"); + }; + eval { + alarm(Apache->request->server->timeout); + @result=$safeeval->reval($code); + alarm(0); + }; + my $error=$@; + if (($Apache::run::timeout || $error ne '') && !$hideerrors) { + if ($Apache::run::timeout) { + $error = 'Code ran too long. It ran for more than '. + Apache->request->server->timeout.' seconds'; + } + &Apache::lonxml::error(''.&HTML::Entities::encode($error). + 'occured while running'. + &HTML::Entities::encode($code).''); + } + if ( $#result < '1') { + return $result[0]; + } else { + &Apache::lonxml::debug("Got lots results:$#result:"); + return (@result); + } } sub dump {