Parent Directory
| 
Revision Log
Revision 986 - (view) (download) (as text)
| 1 : | sh002i | 448 | ################################################################################ |
| 2 : | sh002i | 494 | # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project |
| 3 : | sh002i | 448 | # $Id$ |
| 4 : | ################################################################################ | ||
| 5 : | |||
| 6 : | sh002i | 455 | package Apache::WeBWorK; |
| 7 : | malsyned | 283 | |
| 8 : | sh002i | 455 | =head1 NAME |
| 9 : | malsyned | 283 | |
| 10 : | sh002i | 986 | Apache::WeBWorK - mod_perl handler for WeBWorK. |
| 11 : | malsyned | 357 | |
| 12 : | sh002i | 986 | =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 /webwork> | ||
| 21 : | SetHandler perl-script | ||
| 22 : | PerlHandler Apache::WeBWorK | ||
| 23 : | PerlSetVar webwork_root /path/to/webwork-modperl | ||
| 24 : | <Perl> | ||
| 25 : | use lib '/path/to/webwork-modperl/lib'; | ||
| 26 : | use lib '/path/to/webwork-modperl/pglib'; | ||
| 27 : | </Perl> | ||
| 28 : | </Location> | ||
| 29 : | </IfModule> | ||
| 30 : | |||
| 31 : | sh002i | 455 | =cut |
| 32 : | malsyned | 283 | |
| 33 : | sh002i | 986 | use strict; |
| 34 : | use warnings; | ||
| 35 : | |||
| 36 : | sh002i | 971 | # CGI::Carp makes pretty log and browser error messages. It should be loaded as |
| 37 : | sh002i | 986 | # early as is possible. |
| 38 : | sh002i | 971 | BEGIN { |
| 39 : | sh002i | 986 | use CGI::Carp qw(fatalsToBrowser set_message); |
| 40 : | sh002i | 971 | # CGI::Carp needs a little patch to make it work with the "vanilla" |
| 41 : | # mod_perl API (as opposed to Apache::Registry). _longmess is supposed | ||
| 42 : | # to filter out evals that are always there, as a result of being run | ||
| 43 : | # under mod_perl. Under the "vanilla" API, the first stack frame is | ||
| 44 : | # "eval {...} called at /dev/null line 0". This needs to be removed. | ||
| 45 : | # | ||
| 46 : | # [later:] | ||
| 47 : | # | ||
| 48 : | # Ok, so apparently, when a die happens during compilation, the first | ||
| 49 : | # stack frame is the following: | ||
| 50 : | # | ||
| 51 : | # eval 'require Apache::WeBWorK | ||
| 52 : | # ;' called at /path/to/lib/Apache/WeBWorK.pm line 0 | ||
| 53 : | # | ||
| 54 : | sh002i | 986 | # So I'll try to handle that too. |
| 55 : | sh002i | 971 | sub CGI::Carp::_longmess { |
| 56 : | my $message = Carp::longmess(); | ||
| 57 : | sh002i | 986 | if (exists $ENV{MOD_PERL}) { |
| 58 : | $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s; | ||
| 59 : | $message =~ s,eval[^\n]+/dev/null line 0.*,,s; | ||
| 60 : | my $pkg = __PACKAGE__; | ||
| 61 : | $message =~ s/eval 'require $pkg\n.*//s; | ||
| 62 : | } | ||
| 63 : | sh002i | 971 | |
| 64 : | return $message; | ||
| 65 : | } | ||
| 66 : | sh002i | 986 | # Much of this is stolen from &CGI::Carp::fatalsToBrowser; |
| 67 : | my $customErrorMessage = sub { | ||
| 68 : | my ($message) = @_; | ||
| 69 : | my $stack = Carp::longmess(); | ||
| 70 : | my $wm = ($ENV{SERVER_ADMIN} | ||
| 71 : | ? qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] | ||
| 72 : | : "this site's webmaster"); | ||
| 73 : | my $mess = <<EOF; | ||
| 74 : | <html><head><title>WeBWorK - Software Error</title></head><body> <h2>WeBWorK - | ||
| 75 : | Software Error</h2><h3>Error message</h3><blockquote><pre>$message</pre> | ||
| 76 : | </blockquote><h3>Error context</h3><blockquote><pre>$stack</pre></blockquote> | ||
| 77 : | <p>For help, please send mail to $wm, giving this error message and the time | ||
| 78 : | and date of the error.</p></body></html> | ||
| 79 : | EOF | ||
| 80 : | if (exists $ENV{MOD_PERL} && (my $r = Apache->request)) { | ||
| 81 : | # If bytes have already been sent, then we print the | ||
| 82 : | # message out directly. Otherwise we make a custom | ||
| 83 : | # error handler to produce the doc for us. | ||
| 84 : | if ($r->bytes_sent) { | ||
| 85 : | $r->print($mess); | ||
| 86 : | $r->exit; | ||
| 87 : | } else { | ||
| 88 : | $r->status(500); | ||
| 89 : | $r->custom_response(500,$mess); | ||
| 90 : | } | ||
| 91 : | } else { | ||
| 92 : | print STDOUT $mess; | ||
| 93 : | } | ||
| 94 : | }; | ||
| 95 : | set_message($customErrorMessage); | ||
| 96 : | sh002i | 971 | } |
| 97 : | |||
| 98 : | sh002i | 986 | use WeBWorK; |
| 99 : | malsyned | 283 | |
| 100 : | sh002i | 986 | sub handler($) { |
| 101 : | my ($apache) = @_; | ||
| 102 : | sh002i | 476 | |
| 103 : | sh002i | 986 | return WeBWorK::dispatch($apache); |
| 104 : | malsyned | 283 | } |
| 105 : | |||
| 106 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |