Parent Directory
| 
Revision Log
Fixed problem where a success message was issued even when a mail merge file was not correctly saved. Also made cosmetic modifications to the error message format so that it doesn't look as frightening and the important error message is highlited more than the boiler plate message
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/Apache/WeBWorK.pm,v 1.65 2004/03/15 02:25:08 sh002i Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package Apache::WeBWorK; 18 #use base qw(DB); 19 20 =head1 NAME 21 22 Apache::WeBWorK - mod_perl handler for WeBWorK. 23 24 =head1 CONFIGURATION 25 26 This module should be installed as a Handler for the location selected for 27 WeBWorK on your webserver. Here is an example of a stanza that can be added to 28 your httpd.conf file to achieve this: 29 30 <IfModule mod_perl.c> 31 PerlFreshRestart On 32 <Location /webwork2> 33 SetHandler perl-script 34 PerlHandler Apache::WeBWorK 35 36 PerlSetVar webwork_root /path/to/webwork2 37 PerlSetVar pg_root /path/to/pg 38 39 <Perl> 40 use lib '/path/to/webwork2/lib'; 41 use lib '/path/to/pg/lib'; 42 </Perl> 43 </Location> 44 </IfModule> 45 46 =cut 47 48 use strict; 49 use warnings; 50 use HTML::Entities; 51 use WeBWorK; 52 53 sub handler($) { 54 my ($r) = @_; 55 56 my $result; 57 { # limit the scope of signal localization 58 # the __WARN__ handler stores warnings for later retrieval 59 local $SIG{__WARN__} = sub { 60 my ($warning) = @_; 61 my $warnings = $r->notes("warnings"); 62 $warnings .= "$warning\n"; 63 $r->notes("warnings" => $warnings); 64 warn $warning; # send it to the log 65 }; 66 67 # the __DIE__ handler stores the call stack at the time of an error 68 local $SIG{__DIE__} = sub { 69 my ($error) = @_; 70 # Traces are still causing problems 71 #my $trace = join "\n", Apache::WeBWorK->backtrace(); 72 #$r->notes("lastCallStack" => $trace); 73 die $error; 74 }; 75 76 $result = eval { WeBWorK::dispatch($r) }; 77 } 78 79 if ($@) { 80 print STDERR "uncaught exception in Apache::WeBWorK::handler: $@"; 81 my $message = message($r, $@); 82 unless ($r->bytes_sent) { 83 $r->content_type("text/html"); 84 $r->send_http_header; 85 $message = "<html><body>$message</body></html>"; 86 } 87 $r->print($message); 88 $r->exit; 89 } 90 91 return $result; 92 } 93 94 sub htmlBacktrace(@) { 95 foreach (@_) { 96 s/\</</g; 97 s/\>/>/g; 98 $_ = "<li><tt>$_</tt></li>"; 99 } 100 return join "\n", @_; 101 } 102 103 sub htmlWarningsList(@) { 104 foreach (@_) { 105 next unless m/\S/; 106 s/\</</g; 107 s/\>/>/g; 108 $_ = "<li><tt>$_</tt></li>"; 109 } 110 return join "\n", @_; 111 } 112 113 sub htmlEscape($) { 114 my ($s) = @_; 115 $s = encode_entities($s); 116 $s =~ s/\n/<br>/g; 117 return $s; 118 } 119 120 sub message($$) { 121 my ($r, $exception) = @_; 122 123 $exception = htmlEscape($exception); 124 my $admin = ($ENV{SERVER_ADMIN} 125 ? "(<a href=\"mailto:$ENV{SERVER_ADMIN}\">$ENV{SERVER_ADMIN}</a>)" 126 : ""); 127 my $context = $r->notes("lastCallStack") 128 ? htmlBacktrace(split m/\n/, $r->notes("lastCallStack")) 129 : ""; 130 my $warnings = $r->notes("warnings") 131 ? htmlWarningsList(split m/\n/, $r->notes("warnings")) 132 : ""; 133 my $method = $r->method; 134 my $uri = $r->uri; 135 my $headers = do { 136 my %headers = $r->headers_in; 137 join("", map { "<tr><td><small>$_</small></td><td><small>$headers{$_}</small></td></tr>" } keys %headers); 138 }; 139 140 return <<EOF; 141 <div align="left"> 142 <hr> 143 <p>An error has occured while trying to process your request. </p> 144 145 <h3>Error message</h3> 146 <div style="color:blue; "> 147 <ul><tt>$exception</tt></ul> 148 </div> 149 <!--<h2>Call stack</h2> 150 <ul>$context</ul>--> 151 <hr> 152 <h3>Additonal warnings</h3> 153 <ul>$warnings</ul> 154 <p> 155 For help, please 156 send mail to this site's webmaster $admin giving as much information 157 as you can about the error and the date and time that the error occured. Some hints:</p> 158 <ul> 159 <li>An error about an <tt>undefined value</tt> often means that you asked for 160 an object (like a user, problem set, or problem) that does not exist, and the 161 we (the programmers) were negligent in checking for that.</li> 162 <li>An error about <tt>permission denied</tt> might suggest that the web 163 server does not have permission to read or write a file or directory.</li> 164 </ul> 165 <h2>Request information</h2> 166 <table border="1"> 167 <tr><td>Method</td><td>$method</td></tr> 168 <tr><td>URI</td><td>$uri</td></tr> 169 <tr><td>HTTP Headers</td><td> 170 <table width="90%"> 171 $headers 172 </table> 173 </td></tr> 174 </table> 175 </div> 176 EOF 177 } 178 179 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |