--- trunk/webwork-modperl/lib/Apache/WeBWorK.pm 2003/06/11 19:32:31 1130 +++ trunk/webwork-modperl/lib/Apache/WeBWorK.pm 2003/06/11 20:40:11 1131 @@ -33,62 +33,121 @@ use strict; use warnings; -use WeBWorK; # leave compile-time errors alone. +use DB; +use WeBWorK; sub handler($) { my ($r) = @_; - my $result = eval { - WeBWorK::dispatch($r) + + my $result = do { # scope of signal localization + # the __WARN__ handler stores warnings for later retrieval + local $SIG{__WARN__} = sub { + my ($warning) = @_; + my $warnings = $r->notes("warnings"); + $warnings .= "$warning\n"; + $r->notes("warnings" => $warnings); + warn $warning; # send it to the log + }; + + # the __DIE__ handler stores the call stack at the time of an error + local $SIG{__DIE__} = sub { + my ($error) = @_; + my $trace = join "\n", DB::backtrace(); + $r->notes("lastCallStack" => $trace); + die $error; + }; + + eval { WeBWorK::dispatch($r) }; }; + if ($@) { + print STDERR "uncaught exception in Apache::WeBWorK::handler: $@"; my $message = message($r, $@); unless ($r->bytes_sent) { - $message = "$message"; $r->content_type("text/html"); $r->send_http_header; + $message = "$message"; } $r->print($message); - die $@; + $r->exit; } return $result; } +sub htmlBacktrace(@) { + foreach (@_) { + s/\/>/g; + $_ = "
  • $_
    • "; + } + return join "\n", @_; +} + +sub htmlWarningsList(@) { + foreach (@_) { + next unless m/\S/; + s/\/>/g; + $_ = "
  • $_
    • "; + } + return join "\n", @_; +} + +sub htmlEscape($) { + $_[0] =~ s/\/>/g; + return $_[0]; +} + sub message($$) { my ($r, $exception) = @_; + $exception = htmlEscape($exception); my $admin = ($ENV{SERVER_ADMIN} ? "($ENV{SERVER_ADMIN})" : ""); - # Error context doesn't work yet -- calling longmess() from here is stupid - #my $context = Carp::longmess(); + my $context = $r->notes("lastCallStack") + ? htmlBacktrace(split m/\n/, $r->notes("lastCallStack")) + : ""; + my $warnings = $r->notes("warnings") + ? htmlWarningsList(split m/\n/, $r->notes("warnings")) + : ""; my $method = $r->method; my $uri = $r->uri; my $headers = do { my %headers = $r->headers_in; - join("", map { "$_$headers{$_}" } keys %headers); + join("", map { "$_$headers{$_}" } keys %headers); }; return <

    Software Error

    -

    An error has occured while trying to process you request. For help, please send mail to this site's webmaster $admin giving the following information about the error and the date and time that the error occured.

    +

    An error has occured while trying to process your request. For help, please + send mail to this site's webmaster $admin giving the following information + about the error and the date and time that the error occured. Some hints:

    +

    Error message

    - 
    $exception
    +

    $exception

    +

    Call stack

    + +

    Warnings

    +

    Request information

    -
    -
    Method
    -
    $method
    -
    URI
    -
    $uri
    -
    -

    Headers received

    - $headers
    + + + + +
    Method$method
    URI$uri
    HTTP Headers + + $headers +
    +
    EOF - #

    Error context

    - #
    - # 
    $context
    - #
    } 1;