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 SAVEERR. Some
75 servers, when dealing with CGI scripts, close their connection to the
76 browser when the script closes STDOUT and STDERR. SAVEERR is used 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 "Got an error: $msg";
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.
147 1.05 carpout() added and minor corrections by Marc Hedlund
148 <hedlund@best.com> on 11/26/95.
150 1.06 fatalsToBrowser() no longer aborts for fatal errors within
153 1.08 set_message() added and carpout() expanded to allow for FileHandle
156 1.09 set_message() now allows users to pass a code REFERENCE for
157 really custom error messages. croak and carp are now
158 exported by default. Thanks to Gunther Birznieks for the
161 1.10 Patch from Chris Dean (ctdean@cogit.com) to allow
162 module to run correctly under mod_perl.
164 1.11 Changed order of > and < escapes.
166 1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
168 1.13 Added cluck() to make the module orthogonal with Carp.
169 More mod_perl related fixes.
173 Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
175 This library is free software; you can redistribute it and/or modify
176 it under the same terms as Perl itself.
178 Address bug reports and comments to: lstein@cshl.org
182 Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
192 @EXPORT = qw(confess croak carp);
193 @EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck);
197 ? eval q#sub ineval { defined $^S ? $^S : _longmess() =~ /eval [\{\']/m }#
198 : eval q#sub ineval { _longmess() =~ /eval [\{\']/m }#;
202 $main::SIG{__WARN__}=\&CGI::Carp::warn;
203 $main::SIG{__DIE__}=\&CGI::Carp::die;
204 $CGI::Carp::VERSION = '1.16';
205 $CGI::Carp::CUSTOM_MSG = undef;
207 # fancy import routine detects and handles 'errorWrap' specially.
211 grep($routines{$_}++,@_,@EXPORT);
212 $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
213 my($oldlevel) = $Exporter::ExportLevel;
214 $Exporter::ExportLevel = 1;
215 Exporter::import($pkg,keys %routines);
216 $Exporter::ExportLevel = $oldlevel;
219 # These are the originals
220 sub realwarn { CORE::warn(@_); }
221 sub realdie { CORE::die(@_); }
225 my($pack,$file,$line,$sub) = caller($level);
226 my($id) = $file=~m|([^/]+)\z|;
227 return ($file,$line,$id);
231 my $time = scalar(localtime);
233 my ($id,$pack,$file);
236 ($pack,$file) = caller($frame++);
238 ($id) = $id=~m|([^/]+)\z|;
239 return "[$time] $id: ";
244 my($file,$line,$id) = id(1);
245 $message .= " at $file line $line.\n" unless $message=~/\n$/;
247 $message=~s/^/$stamp/gm;
251 # The mod_perl package Apache::Registry loads CGI programs by calling
252 # eval. These evals don't count when looking at the stack backtrace.
254 my $message = Carp::longmess();
255 my $mod_perl = exists $ENV{MOD_PERL};
256 $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
261 realdie @_ if ineval;
263 my $time = scalar(localtime);
264 my($file,$line,$id) = id(1);
265 $message .= " at $file line $line." unless $message=~/\n$/;
266 &fatalsToBrowser($message) if $WRAP;
268 $message=~s/^/$stamp/gm;
273 $CGI::Carp::CUSTOM_MSG = shift;
274 return $CGI::Carp::CUSTOM_MSG;
277 # Avoid generating "subroutine redefined" warnings with the following
282 sub confess { CGI::Carp::die Carp::longmess \@_; }
283 sub croak { CGI::Carp::die Carp::shortmess \@_; }
284 sub carp { CGI::Carp::warn Carp::shortmess \@_; }
285 sub cluck { CGI::Carp::warn Carp::longmess \@_; }
290 # We have to be ready to accept a filehandle as a reference
294 my($no) = fileno(to_filehandle($in));
295 realdie("Invalid filehandle $in\n") unless defined $no;
297 open(SAVEERR, ">&STDERR");
298 open(STDERR, ">&$no") or
299 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
303 sub fatalsToBrowser {
309 my($wm) = $ENV{SERVER_ADMIN} ?
310 qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
311 "this site's webmaster";
312 my ($outer_message) = <<END;
313 For help, please send mail to $wm, giving this error message
314 and the time and date of the error.
317 my $mod_perl = exists $ENV{MOD_PERL};
318 print STDOUT "Content-type: text/html\n\n"
322 if (ref($CUSTOM_MSG) eq 'CODE') {
323 &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
326 $outer_message = $CUSTOM_MSG;
331 <H1>Software error:</H1>
338 if ($mod_perl && (my $r = Apache->request)) {
339 # If bytes have already been sent, then
340 # we print the message out directly.
341 # Otherwise we make a custom error
342 # handler to produce the doc for us.
343 if ($r->bytes_sent) {
348 $r->custom_response(500,$mess);
355 # Cut and paste from CGI.pm so that we don't have the overhead of
356 # always loading the entire CGI module.
359 return undef unless $thingy;
360 return $thingy if UNIVERSAL::isa($thingy,'GLOB');
361 return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
364 while (my $package = caller($caller++)) {
365 my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
366 return $tmp if defined(fileno($tmp));