5 B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
11 croak "We're outta here!";
12 confess "It was my fault: $!";
13 carp "It was your fault!";
17 use CGI::Carp qw(cluck);
18 cluck "I wouldn't do that if I were you";
20 use CGI::Carp qw(fatalsToBrowser);
21 die "Fatal error messages are now sent to browser";
25 CGI scripts have a nasty habit of leaving warning messages in the error
26 logs that are neither time stamped nor fully identified. Tracking down
27 the script that caused the error is a pain. This fixes that. Replace
36 And the standard warn(), die (), croak(), confess() and carp() calls
37 will automagically be replaced with functions that write out nicely
38 time-stamped messages to the HTTP server error log.
42 [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3.
43 [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied.
44 [Fri Nov 17 21:40:43 1995] test.pl: I'm dying.
46 =head1 REDIRECTING ERROR MESSAGES
48 By default, error messages are sent to STDERR. Most HTTPD servers
49 direct STDERR to the server's error log. Some applications may wish
50 to keep private error logs, distinct from the server's error log, or
51 they may wish to direct error messages to STDOUT so that the browser
54 The C<carpout()> function is provided for this purpose. Since
55 carpout() is not exported by default, you must import it explicitly by
58 use CGI::Carp qw(carpout);
60 The carpout() function requires one argument, which should be a
61 reference to an open filehandle for writing errors. It should be
62 called in a C<BEGIN> block at the top of the CGI application so that
63 compiler errors will be caught. Example:
66 use CGI::Carp qw(carpout);
67 open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or
68 die("Unable to open mycgi-log: $!\n");
72 carpout() does not handle file locking on the log for you at this point.
74 The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR. Some
75 servers, when dealing with CGI scripts, close their connection to the
76 browser when the script closes STDOUT and STDERR. CGI::Carp::SAVEERR is there to
77 prevent this from happening prematurely.
79 You can pass filehandles to carpout() in a variety of ways. The "correct"
80 way according to Tom Christiansen is to pass a reference to a filehandle
85 This looks weird to mere mortals however, so the following syntaxes are
92 carpout(\'main::LOG');
96 FileHandle and other objects work as well.
98 Use of carpout() is not great for performance, so it is recommended
99 for debugging purposes or for moderate-use applications. A future
100 version of this module may delay redirecting STDERR until one of the
101 CGI::Carp methods is called to prevent the performance hit.
103 =head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
105 If you want to send fatal (die, confess) errors to the browser, ask to
106 import the special "fatalsToBrowser" subroutine:
108 use CGI::Carp qw(fatalsToBrowser);
109 die "Bad error here";
111 Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp
112 arranges to send a minimal HTTP header to the browser so that even errors that
113 occur in the early compile phase will be seen.
114 Nonfatal errors will still be directed to the log file only (unless redirected
117 =head2 Changing the default message
119 By default, the software error message is followed by a note to
120 contact the Webmaster by e-mail with the time and date of the error.
121 If this message is not to your liking, you can change it using the
122 set_message() routine. This is not imported by default; you should
123 import it on the use() line:
125 use CGI::Carp qw(fatalsToBrowser set_message);
126 set_message("It's not a bug, it's a feature!");
128 You may also pass in a code reference in order to create a custom
129 error message. At run time, your code will be called with the text
130 of the error message that caused the script to die. Example:
132 use CGI::Carp qw(fatalsToBrowser set_message);
136 print "<h1>Oh gosh</h1>";
137 print "<p>Got an error: $msg</p>";
139 set_message(\&handle_errors);
142 In order to correctly intercept compile-time errors, you should call
143 set_message() from within a BEGIN{} block.
145 =head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
147 It is now also possible to make non-fatal errors appear as HTML
148 comments embedded in the output of your program. To enable this
149 feature, export the new "warningsToBrowser" subroutine. Since sending
150 warnings to the browser before the HTTP headers have been sent would
151 cause an error, any warnings are stored in an internal buffer until
152 you call the warningsToBrowser() subroutine with a true argument:
154 use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
155 use CGI qw(:standard);
157 warningsToBrowser(1);
159 You may also give a false argument to warningsToBrowser() to prevent
160 warnings from being sent to the browser while you are printing some
161 content where HTML comments are not allowed:
163 warningsToBrowser(0); # disable warnings
164 print "<script type=\"text/javascript\"><!--\n";
165 print_some_javascript_code();
166 print "//--></script>\n";
167 warningsToBrowser(1); # re-enable warnings
169 Note: In this respect warningsToBrowser() differs fundamentally from
170 fatalsToBrowser(), which you should never call yourself!
174 1.05 carpout() added and minor corrections by Marc Hedlund
175 <hedlund@best.com> on 11/26/95.
177 1.06 fatalsToBrowser() no longer aborts for fatal errors within
180 1.08 set_message() added and carpout() expanded to allow for FileHandle
183 1.09 set_message() now allows users to pass a code REFERENCE for
184 really custom error messages. croak and carp are now
185 exported by default. Thanks to Gunther Birznieks for the
188 1.10 Patch from Chris Dean (ctdean@cogit.com) to allow
189 module to run correctly under mod_perl.
191 1.11 Changed order of > and < escapes.
193 1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
195 1.13 Added cluck() to make the module orthogonal with Carp.
196 More mod_perl related fixes.
198 1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi): Added
199 warningsToBrowser(). Replaced <CODE> tags with <PRE> in
200 fatalsToBrowser() output.
202 1.23 ineval() now checks both $^S and inspects the message for the "eval" pattern
203 (hack alert!) in order to accomodate various combinations of Perl and
208 Copyright 1995-2002, Lincoln D. Stein. All rights reserved.
210 This library is free software; you can redistribute it and/or modify
211 it under the same terms as Perl itself.
213 Address bug reports and comments to: lstein@cshl.org
217 Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
225 BEGIN { require Carp; }
229 @EXPORT = qw(confess croak carp);
230 @EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message cluck);
232 $main::SIG{__WARN__}=\&CGI::Carp::warn;
233 $main::SIG{__DIE__}=\&CGI::Carp::die;
234 $CGI::Carp::VERSION = '1.23';
235 $CGI::Carp::CUSTOM_MSG = undef;
237 # fancy import routine detects and handles 'errorWrap' specially.
241 grep($routines{$_}++,@_,@EXPORT);
242 $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
243 $WARN++ if $routines{'warningsToBrowser'};
244 my($oldlevel) = $Exporter::ExportLevel;
245 $Exporter::ExportLevel = 1;
246 Exporter::import($pkg,keys %routines);
247 $Exporter::ExportLevel = $oldlevel;
250 # These are the originals
251 sub realwarn { CORE::warn(@_); }
252 sub realdie { CORE::die(@_); }
256 my($pack,$file,$line,$sub) = caller($level);
257 my($dev,$dirs,$id) = File::Spec->splitpath($file);
258 return ($file,$line,$id);
262 my $time = scalar(localtime);
264 my ($id,$pack,$file,$dev,$dirs);
267 ($pack,$file) = caller($frame++);
269 ($dev,$dirs,$id) = File::Spec->splitpath($id);
270 return "[$time] $id: ";
275 my($file,$line,$id) = id(1);
276 $message .= " at $file line $line.\n" unless $message=~/\n$/;
277 _warn($message) if $WARN;
279 $message=~s/^/$stamp/gm;
285 if ($EMIT_WARNINGS) {
286 # We need to mangle the message a bit to make it a valid HTML
287 # comment. This is done by substituting similar-looking ISO
288 # 8859-1 characters for <, > and -. This is a hack.
289 $msg =~ tr/<>-/\253\273\255/;
291 print STDOUT "<!-- warning: $msg -->\n";
293 push @WARNINGS, $msg;
297 sub ineval { $^S || _longmess() =~ /eval [\{\']/m }
299 # The mod_perl package Apache::Registry loads CGI programs by calling
300 # eval. These evals don't count when looking at the stack backtrace.
302 my $message = Carp::longmess();
303 my $mod_perl = exists $ENV{MOD_PERL};
304 $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
309 realdie @_ if ineval;
311 my $time = scalar(localtime);
312 my($file,$line,$id) = id(1);
313 $message .= " at $file line $line." unless $message=~/\n$/;
314 &fatalsToBrowser($message) if $WRAP;
316 $message=~s/^/$stamp/gm;
321 $CGI::Carp::CUSTOM_MSG = shift;
322 return $CGI::Carp::CUSTOM_MSG;
325 sub confess { CGI::Carp::die Carp::longmess @_; }
326 sub croak { CGI::Carp::die Carp::shortmess @_; }
327 sub carp { CGI::Carp::warn Carp::shortmess @_; }
328 sub cluck { CGI::Carp::warn Carp::longmess @_; }
330 # We have to be ready to accept a filehandle as a reference
334 my($no) = fileno(to_filehandle($in));
335 realdie("Invalid filehandle $in\n") unless defined $no;
337 open(SAVEERR, ">&STDERR");
338 open(STDERR, ">&$no") or
339 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
342 sub warningsToBrowser {
343 $EMIT_WARNINGS = @_ ? shift : 1;
344 _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
348 sub fatalsToBrowser {
354 my($wm) = $ENV{SERVER_ADMIN} ?
355 qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
356 "this site's webmaster";
357 my ($outer_message) = <<END;
358 For help, please send mail to $wm, giving this error message
359 and the time and date of the error.
362 my $mod_perl = exists $ENV{MOD_PERL};
363 print STDOUT "Content-type: text/html\n\n"
366 warningsToBrowser(1); # emit warnings before dying
369 if (ref($CUSTOM_MSG) eq 'CODE') {
370 &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
373 $outer_message = $CUSTOM_MSG;
378 <h1>Software error:</h1>
386 if ($mod_perl && (my $r = Apache->request)) {
387 # If bytes have already been sent, then
388 # we print the message out directly.
389 # Otherwise we make a custom error
390 # handler to produce the doc for us.
391 if ($r->bytes_sent) {
396 $r->custom_response(500,$mess);
403 # Cut and paste from CGI.pm so that we don't have the overhead of
404 # always loading the entire CGI module.
407 return undef unless $thingy;
408 return $thingy if UNIVERSAL::isa($thingy,'GLOB');
409 return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
412 while (my $package = caller($caller++)) {
413 my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
414 return $tmp if defined(fileno($tmp));