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_progname cluck ^name= die);
$main::SIG{__WARN__}=\&CGI::Carp::warn;
-*CORE::GLOBAL::die = \&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.25';
+
+$CGI::Carp::VERSION = '1.27';
$CGI::Carp::CUSTOM_MSG = undef;
+
# fancy import routine detects and handles 'errorWrap' specially.
sub import {
my $pkg = shift;
$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
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') {
+ 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;
<h1>Software error:</h1>
<pre>$msg</pre>
</p>
END
;
-
+
if ($mod_perl) {
require mod_perl;
if ($mod_perl::VERSION >= 1.99) {
$r->print($mess);
$mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
} else {
- # MSIE browsers don't show the $mess when sent
- # a custom 500 response.
+ # MSIE won't display a custom 500 response unless it is >512 bytes!
if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
- $r->send_http_header('text/html');
- $r->print($mess);
- $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
- } else {
- $r->custom_response(500,$mess);
+ $mess = "<!-- " . (' ' x 513) . " -->\n$mess";
}
+ $r->custom_response(500,$mess);
}
} else {
- print STDOUT $mess;
+ 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;
+ }
}
}