carpout() does not handle file locking on the log for you at this point.
-The real STDERR is not closed -- it is moved to SAVEERR. Some
+The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR. Some
servers, when dealing with CGI scripts, close their connection to the
-browser when the script closes STDOUT and STDERR. SAVEERR is used to
+browser when the script closes STDOUT and STDERR. CGI::Carp::SAVEERR is there to
prevent this from happening prematurely.
You can pass filehandles to carpout() in a variety of ways. The "correct"
sub handle_errors {
my $msg = shift;
print "<h1>Oh gosh</h1>";
- print "Got an error: $msg";
+ print "<p>Got an error: $msg</p>";
}
set_message(\&handle_errors);
}
In order to correctly intercept compile-time errors, you should call
set_message() from within a BEGIN{} block.
+=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
+
+It is now also possible to make non-fatal errors appear as HTML
+comments embedded in the output of your program. To enable this
+feature, export the new "warningsToBrowser" subroutine. Since sending
+warnings to the browser before the HTTP headers have been sent would
+cause an error, any warnings are stored in an internal buffer until
+you call the warningsToBrowser() subroutine with a true argument:
+
+ use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
+ use CGI qw(:standard);
+ print header();
+ warningsToBrowser(1);
+
+You may also give a false argument to warningsToBrowser() to prevent
+warnings from being sent to the browser while you are printing some
+content where HTML comments are not allowed:
+
+ warningsToBrowser(0); # disable warnings
+ print "<script type=\"text/javascript\"><!--\n";
+ print_some_javascript_code();
+ print "//--></script>\n";
+ warningsToBrowser(1); # re-enable warnings
+
+Note: In this respect warningsToBrowser() differs fundamentally from
+fatalsToBrowser(), which you should never call yourself!
+
=head1 CHANGE LOG
1.05 carpout() added and minor corrections by Marc Hedlund
1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
1.13 Added cluck() to make the module orthogonal with Carp.
- More mod_perl related fixes.
+ More mod_perl related fixes.
+
+1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi): Added
+ warningsToBrowser(). Replaced <CODE> tags with <PRE> in
+ 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
+ mod_perl.
=head1 AUTHORS
-Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
+Copyright 1995-2002, Lincoln D. Stein. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
require 5.000;
use Exporter;
-use Carp;
+#use Carp;
+BEGIN { require Carp; }
+use File::Spec;
@ISA = qw(Exporter);
@EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck);
-
-BEGIN {
- $] >= 5.005
- ? eval q#sub ineval { $^S }#
- : eval q#sub ineval { _longmess() =~ /eval [\{\']/m }#;
- $@ and die;
-}
+@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message cluck);
$main::SIG{__WARN__}=\&CGI::Carp::warn;
$main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.14';
+$CGI::Carp::VERSION = '1.23';
$CGI::Carp::CUSTOM_MSG = undef;
# fancy import routine detects and handles 'errorWrap' specially.
my(%routines);
grep($routines{$_}++,@_,@EXPORT);
$WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
+ $WARN++ if $routines{'warningsToBrowser'};
my($oldlevel) = $Exporter::ExportLevel;
$Exporter::ExportLevel = 1;
Exporter::import($pkg,keys %routines);
sub id {
my $level = shift;
my($pack,$file,$line,$sub) = caller($level);
- my($id) = $file=~m|([^/]+)\z|;
+ my($dev,$dirs,$id) = File::Spec->splitpath($file);
return ($file,$line,$id);
}
sub stamp {
my $time = scalar(localtime);
my $frame = 0;
- my ($id,$pack,$file);
+ my ($id,$pack,$file,$dev,$dirs);
do {
$id = $file;
($pack,$file) = caller($frame++);
} until !$file;
- ($id) = $id=~m|([^/]+)\z|;
+ ($dev,$dirs,$id) = File::Spec->splitpath($id);
return "[$time] $id: ";
}
my $message = shift;
my($file,$line,$id) = id(1);
$message .= " at $file line $line.\n" unless $message=~/\n$/;
+ _warn($message) if $WARN;
my $stamp = stamp;
$message=~s/^/$stamp/gm;
realwarn $message;
}
+sub _warn {
+ my $msg = shift;
+ if ($EMIT_WARNINGS) {
+ # We need to mangle the message a bit to make it a valid HTML
+ # comment. This is done by substituting similar-looking ISO
+ # 8859-1 characters for <, > and -. This is a hack.
+ $msg =~ tr/<>-/\253\273\255/;
+ chomp $msg;
+ print STDOUT "<!-- warning: $msg -->\n";
+ } else {
+ push @WARNINGS, $msg;
+ }
+}
+
+sub ineval { $^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 );
+ return $message;
}
sub die {
realdie @_ if ineval;
- my $message = shift;
+ my ($message) = @_;
my $time = scalar(localtime);
my($file,$line,$id) = id(1);
$message .= " at $file line $line." unless $message=~/\n$/;
return $CGI::Carp::CUSTOM_MSG;
}
-# Avoid generating "subroutine redefined" warnings with the following
-# hack:
-{
- local $^W=0;
- eval <<EOF;
-sub confess { CGI::Carp::die Carp::longmess \@_; }
-sub croak { CGI::Carp::die Carp::shortmess \@_; }
-sub carp { CGI::Carp::warn Carp::shortmess \@_; }
-sub cluck { CGI::Carp::warn Carp::longmess \@_; }
-EOF
- ;
-}
+sub confess { CGI::Carp::die Carp::longmess @_; }
+sub croak { CGI::Carp::die Carp::shortmess @_; }
+sub carp { CGI::Carp::warn Carp::shortmess @_; }
+sub cluck { CGI::Carp::warn Carp::longmess @_; }
# We have to be ready to accept a filehandle as a reference
# or a string.
( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
}
+sub warningsToBrowser {
+ $EMIT_WARNINGS = @_ ? shift : 1;
+ _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
+}
+
# headers
sub fatalsToBrowser {
my($msg) = @_;
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
}
my $mess = <<END;
-<H1>Software error:</H1>
-<CODE>$msg</CODE>
-<P>
+<h1>Software error:</h1>
+<pre>$msg</pre>
+<p>
$outer_message
+</p>
END
;
- if ($mod_perl) {
- my $r = Apache->request;
+ 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
projects / p5sagit/p5-mst-13.2.git / blobdiff