=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
-If you want to send fatal (die, confess) errors to the browser, ask to
+If you want to send fatal (die, confess) errors to the browser, ask to
import the special "fatalsToBrowser" subroutine:
use CGI::Carp qw(fatalsToBrowser);
Nonfatal errors will still be directed to the log file only (unless redirected
with carpout).
+Note that fatalsToBrowser does B<not> work with mod_perl version 2.0
+and higher.
+
=head2 Changing the default message
By default, the software error message is followed by a note to
In order to correctly intercept compile-time errors, you should call
set_message() from within a BEGIN{} block.
+=head1 DOING MORE THAN PRINTING A MESSAGE IN THE EVENT OF PERL ERRORS
+
+If fatalsToBrowser in conjunction with set_message does not provide
+you with all of the functionality you need, you can go one step
+further by specifying a function to be executed any time a script
+calls "die", has a syntax error, or dies unexpectedly at runtime
+with a line like "undef->explode();".
+
+ use CGI::Carp qw(set_die_handler);
+ BEGIN {
+ sub handle_errors {
+ my $msg = shift;
+ print "content-type: text/html\n\n";
+ print "<h1>Oh gosh</h1>";
+ print "<p>Got an error: $msg</p>";
+
+ #proceed to send an email to a system administrator,
+ #write a detailed message to the browser and/or a log,
+ #etc....
+ }
+ set_die_handler(\&handle_errors);
+ }
+
+Notice that if you use set_die_handler(), you must handle sending
+HTML headers to the browser yourself if you are printing a message.
+
+If you use set_die_handler(), you will most likely interfere with
+the behavior of fatalsToBrowser, so you must use this or that, not
+both.
+
+Using set_die_handler() sets SIG{__DIE__} (as does fatalsToBrowser),
+and there is only one SIG{__DIE__}. This means that if you are
+attempting to set SIG{__DIE__} yourself, you may interfere with
+this module's functionality, or this module may interfere with
+your module's functionality.
+
=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
It is now also possible to make non-fatal errors appear as HTML
=head1 CHANGE LOG
+1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
+ not behaving correctly in an eval() context.
+
1.05 carpout() added and minor corrections by Marc Hedlund
<hedlund@best.com> on 11/26/95.
fatalsToBrowser() output.
1.23 ineval() now checks both $^S and inspects the message for the "eval" pattern
- (hack alert!) in order to accomodate various combinations of Perl and
+ (hack alert!) in order to accommodate various combinations of Perl and
mod_perl.
1.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support
for overriding program name.
+1.26 Replaced CORE::GLOBAL::die with the evil $SIG{__DIE__} because the
+ former isn't working in some people's hands. There is no such thing
+ as reliable exception handling in Perl.
+
+1.27 Replaced tell STDOUT with bytes=tell STDOUT.
+
=head1 AUTHORS
Copyright 1995-2002, Lincoln D. Stein. All rights reserved.
require 5.000;
use Exporter;
#use Carp;
-BEGIN { require Carp; }
+BEGIN {
+ require Carp;
+ *CORE::GLOBAL::die = \&CGI::Carp::die;
+}
+
use File::Spec;
@ISA = qw(Exporter);
@EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_progname cluck ^name=);
+@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_die_handler set_progname cluck ^name= die);
$main::SIG{__WARN__}=\&CGI::Carp::warn;
-*CORE::GLOBAL::die = \&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.24';
-$CGI::Carp::CUSTOM_MSG = undef;
+
+$CGI::Carp::VERSION = '1.29';
+$CGI::Carp::CUSTOM_MSG = undef;
+$CGI::Carp::DIE_HANDLER = undef;
+
# fancy import routine detects and handles 'errorWrap' specially.
sub import {
my $pkg = shift;
my(%routines);
my(@name);
-
if (@name=grep(/^name=/,@_))
{
my($n) = (split(/=/,$name[0]))[1];
$Exporter::ExportLevel = 1;
Exporter::import($pkg,keys %routines);
$Exporter::ExportLevel = $oldlevel;
+ $main::SIG{__DIE__} =\&CGI::Carp::die if $routines{'fatalsToBrowser'};
+# $pkg->export('CORE::GLOBAL','die');
}
# These are the originals
}
}
-sub ineval {
- (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
-}
-
# The mod_perl package Apache::Registry loads CGI programs by calling
# eval. These evals don't count when looking at the stack backtrace.
sub _longmess {
my $message = Carp::longmess();
- my $mod_perl = exists $ENV{MOD_PERL};
- $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
- return $message;
+ $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s
+ if exists $ENV{MOD_PERL};
+ return $message;
+}
+
+sub ineval {
+ (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
}
sub die {
- realdie @_ if ineval;
- my ($message) = @_;
- my $time = scalar(localtime);
- my($file,$line,$id) = id(1);
- $message .= " at $file line $line." unless $message=~/\n$/;
- &fatalsToBrowser($message) if $WRAP;
- my $stamp = stamp;
- $message=~s/^/$stamp/gm;
- realdie $message;
+ my ($arg,@rest) = @_;
+
+ if ($DIE_HANDLER) {
+ &$DIE_HANDLER($arg,@rest);
+ }
+
+ if ( ineval() ) {
+ if (!ref($arg)) {
+ $arg = join("",($arg,@rest)) || "Died";
+ my($file,$line,$id) = id(1);
+ $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
+ realdie($arg);
+ }
+ else {
+ realdie($arg,@rest);
+ }
+ }
+
+ if (!ref($arg)) {
+ $arg = join("", ($arg,@rest));
+ my($file,$line,$id) = id(1);
+ $arg .= " at $file line $line." unless $arg=~/\n$/;
+ &fatalsToBrowser($arg) if $WRAP;
+ if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
+ my $stamp = stamp;
+ $arg=~s/^/$stamp/gm;
+ }
+ if ($arg !~ /\n$/) {
+ $arg .= "\n";
+ }
+ }
+ realdie $arg;
}
sub set_message {
return $CGI::Carp::CUSTOM_MSG;
}
+sub set_die_handler {
+
+ my ($handler) = shift;
+
+ #setting SIG{__DIE__} here is necessary to catch runtime
+ #errors which are not called by literally saying "die",
+ #such as the line "undef->explode();". however, doing this
+ #will interfere with fatalsToBrowser, which also sets
+ #SIG{__DIE__} in the import() function above (or the
+ #import() function above may interfere with this). for
+ #this reason, you should choose to either set the die
+ #handler here, or use fatalsToBrowser, not both.
+ $main::SIG{__DIE__} = $handler;
+
+ $CGI::Carp::DIE_HANDLER = $handler;
+
+ return $CGI::Carp::DIE_HANDLER;
+}
+
sub confess { CGI::Carp::die Carp::longmess @_; }
sub croak { CGI::Carp::die Carp::shortmess @_; }
sub carp { CGI::Carp::warn Carp::shortmess @_; }
# headers
sub fatalsToBrowser {
- my($msg) = @_;
- $msg=~s/&/&/g;
- $msg=~s/>/>/g;
- $msg=~s/</</g;
- $msg=~s/\"/"/g;
- my($wm) = $ENV{SERVER_ADMIN} ?
- qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
- "this site's webmaster";
- my ($outer_message) = <<END;
+ my($msg) = @_;
+ $msg=~s/&/&/g;
+ $msg=~s/>/>/g;
+ $msg=~s/</</g;
+ $msg=~s/\"/"/g;
+ my($wm) = $ENV{SERVER_ADMIN} ?
+ qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
+ "this site's webmaster";
+ my ($outer_message) = <<END;
For help, please send mail to $wm, giving this error message
and the time and date of the error.
END
- ;
- my $mod_perl = exists $ENV{MOD_PERL};
- print STDOUT "Content-type: text/html\n\n"
- unless $mod_perl;
-
- warningsToBrowser(1); # emit warnings before dying
-
- if ($CUSTOM_MSG) {
- if (ref($CUSTOM_MSG) eq 'CODE') {
- &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
- return;
- } else {
- $outer_message = $CUSTOM_MSG;
- }
+ ;
+ my $mod_perl = exists $ENV{MOD_PERL};
+
+ if ($CUSTOM_MSG) {
+ if (ref($CUSTOM_MSG) eq 'CODE') {
+ print STDOUT "Content-type: text/html\n\n"
+ unless $mod_perl;
+ &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+ return;
+ } else {
+ $outer_message = $CUSTOM_MSG;
}
-
- my $mess = <<END;
+ }
+
+ my $mess = <<END;
<h1>Software error:</h1>
<pre>$msg</pre>
<p>
$outer_message
</p>
END
- ;
-
- if ($mod_perl && (my $r = Apache->request)) {
- # If bytes have already been sent, then
- # we print the message out directly.
- # Otherwise we make a custom error
- # handler to produce the doc for us.
- if ($r->bytes_sent) {
- $r->print($mess);
- $r->exit;
- } else {
- $r->status(500);
- $r->custom_response(500,$mess);
- }
+ ;
+
+ if ($mod_perl) {
+ my $r;
+ if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
+ $mod_perl = 2;
+ require Apache2::RequestRec;
+ require Apache2::RequestIO;
+ require Apache2::RequestUtil;
+ require APR::Pool;
+ require ModPerl::Util;
+ require Apache2::Response;
+ $r = Apache2::RequestUtil->request;
+ }
+ else {
+ $r = Apache->request;
+ }
+ # If bytes have already been sent, then
+ # we print the message out directly.
+ # Otherwise we make a custom error
+ # handler to produce the doc for us.
+ if ($r->bytes_sent) {
+ $r->print($mess);
+ $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
} else {
- print STDOUT $mess;
+ # MSIE won't display a custom 500 response unless it is >512 bytes!
+ if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
+ $mess = "<!-- " . (' ' x 513) . " -->\n$mess";
+ }
+ $r->custom_response(500,$mess);
}
+ } else {
+ my $bytes_written = eval{tell STDOUT};
+ if (defined $bytes_written && $bytes_written > 0) {
+ print STDOUT $mess;
+ }
+ else {
+ print STDOUT "Content-type: text/html\n\n";
+ print STDOUT $mess;
+ }
+ }
+
+ warningsToBrowser(1); # emit warnings before dying
}
# Cut and paste from CGI.pm so that we don't have the overhead of
projects / p5sagit/p5-mst-13.2.git / blobdiff