Parent Directory
| 
Revision Log
changed calls to Apache::DB::backtrace with calls to Apache::DB->backtrace to eliminate warning about that. -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package Apache::WeBWorK; 7 8 =head1 NAME 9 10 Apache::WeBWorK - mod_perl handler for WeBWorK. 11 12 =head1 CONFIGURATION 13 14 This module should be installed as a Handler for the location selected for 15 WeBWorK on your webserver. Here is an example of a stanza that can be added to 16 your httpd.conf file to achieve this: 17 18 <IfModule mod_perl.c> 19 PerlFreshRestart On 20 <Location /webwork2> 21 SetHandler perl-script 22 PerlHandler Apache::WeBWorK 23 PerlSetVar webwork_root /path/to/webwork-modperl 24 PerlSetVar pg_root /path/to/pg 25 <Perl> 26 use lib '/path/to/webwork-modperl/lib'; 27 use lib '/path/to/pg/lib'; 28 </Perl> 29 </Location> 30 </IfModule> 31 32 =cut 33 34 use strict; 35 use warnings; 36 use Apache::DB; 37 use WeBWorK; 38 39 sub handler($) { 40 my ($r) = @_; 41 42 my $result = do { # scope of signal localization 43 # the __WARN__ handler stores warnings for later retrieval 44 local $SIG{__WARN__} = sub { 45 my ($warning) = @_; 46 my $warnings = $r->notes("warnings"); 47 $warnings .= "$warning\n"; 48 $r->notes("warnings" => $warnings); 49 warn $warning; # send it to the log 50 }; 51 52 # the __DIE__ handler stores the call stack at the time of an error 53 local $SIG{__DIE__} = sub { 54 my ($error) = @_; 55 my $trace = join "\n", Apache::DB->backtrace(); 56 $r->notes("lastCallStack" => $trace); 57 die $error; 58 }; 59 60 eval { WeBWorK::dispatch($r) }; 61 }; 62 63 if ($@) { 64 print STDERR "uncaught exception in Apache::WeBWorK::handler: $@"; 65 my $message = message($r, $@); 66 unless ($r->bytes_sent) { 67 $r->content_type("text/html"); 68 $r->send_http_header; 69 $message = "<html><body>$message</body></html>"; 70 } 71 $r->print($message); 72 $r->exit; 73 } 74 return $result; 75 } 76 77 sub htmlBacktrace(@) { 78 foreach (@_) { 79 s/\</</g; 80 s/\>/>/g; 81 $_ = "<li><tt>$_</tt></li>"; 82 } 83 return join "\n", @_; 84 } 85 86 sub htmlWarningsList(@) { 87 foreach (@_) { 88 next unless m/\S/; 89 s/\</</g; 90 s/\>/>/g; 91 $_ = "<li><tt>$_</tt></li>"; 92 } 93 return join "\n", @_; 94 } 95 96 sub htmlEscape($) { 97 $_[0] =~ s/\</</g; 98 $_[0] =~ s/\>/>/g; 99 return $_[0]; 100 } 101 102 sub message($$) { 103 my ($r, $exception) = @_; 104 105 $exception = htmlEscape($exception); 106 my $admin = ($ENV{SERVER_ADMIN} 107 ? "(<a href=\"mailto:$ENV{SERVER_ADMIN}\">$ENV{SERVER_ADMIN}</a>)" 108 : ""); 109 my $context = $r->notes("lastCallStack") 110 ? htmlBacktrace(split m/\n/, $r->notes("lastCallStack")) 111 : ""; 112 my $warnings = $r->notes("warnings") 113 ? htmlWarningsList(split m/\n/, $r->notes("warnings")) 114 : ""; 115 my $method = $r->method; 116 my $uri = $r->uri; 117 my $headers = do { 118 my %headers = $r->headers_in; 119 join("", map { "<tr><td><small>$_</small></td><td><small>$headers{$_}</small></td></tr>" } keys %headers); 120 }; 121 122 return <<EOF; 123 <div align="left"> 124 <h1>Software Error</h1> 125 <p>An error has occured while trying to process your request. For help, please 126 send mail to this site's webmaster $admin giving the following information 127 about the error and the date and time that the error occured. Some hints:</p> 128 <ul> 129 <li>An error about an <tt>undefined value</tt> often means that you asked for 130 an object (like a user, problem set, or problem) that does not exist, and the 131 we (the programmers) were negligent in checking for that.</li> 132 </ul> 133 <h2>Error message</h2> 134 <p><tt>$exception</tt></p> 135 <h2>Call stack</h2> 136 <ul>$context</ul> 137 <h2>Warnings</h2> 138 <ul>$warnings</ul> 139 <h2>Request information</h2> 140 <table border="1"> 141 <tr><td>Method</td><td>$method</td></tr> 142 <tr><td>URI</td><td>$uri</td></tr> 143 <tr><td>HTTP Headers</td><td> 144 <table> 145 $headers 146 </table> 147 </td></tr> 148 </table> 149 </div> 150 EOF 151 } 152 153 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |