Got an error: $msg
"; } set_message(\&handle_errors); } @@ -142,6 +142,33 @@ of the error message that caused the script to die. Example: 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 "\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 @@ -166,11 +193,19 @@ set_message() from within a BEGIN{} block. 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 tags with 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.
@@ -186,22 +221,17 @@ CGI::Response
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 { defined $^S ? $^S : _longmess() =~ /eval [\{\']/m }#
- : 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.16';
+$CGI::Carp::VERSION = '1.23';
$CGI::Carp::CUSTOM_MSG = undef;
# fancy import routine detects and handles 'errorWrap' specially.
@@ -210,6 +240,7 @@ sub import {
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);
@@ -223,19 +254,19 @@ sub realdie { CORE::die(@_); }
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: ";
}
@@ -243,23 +274,40 @@ sub warn {
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 "\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$/;
@@ -274,18 +322,10 @@ sub set_message {
return $CGI::Carp::CUSTOM_MSG;
}
-# Avoid generating "subroutine redefined" warnings with the following
-# hack:
-{
- local $^W=0;
- eval <Software error:
-$msg
-
+
Software error:
+$msg
+
$outer_message
+
END
;