lib/CGI/Carp.pm

   1 package CGI::Carp;
   2
   3 =head1 NAME
   4
   5 B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
   6
   7 =head1 SYNOPSIS
   8
   9     use CGI::Carp;
  10
  11     croak "We're outta here!";
  12     confess "It was my fault: $!";
  13     carp "It was your fault!";
  14     warn "I'm confused";
  15     die  "I'm dying.\n";
  16
  17 =head1 DESCRIPTION
  18
  19 CGI scripts have a nasty habit of leaving warning messages in the error
  20 logs that are neither time stamped nor fully identified.  Tracking down
  21 the script that caused the error is a pain.  This fixes that.  Replace
  22 the usual
  23
  24     use Carp;
  25
  26 with
  27
  28     use CGI::Carp
  29
  30 And the standard warn(), die (), croak(), confess() and carp() calls
  31 will automagically be replaced with functions that write out nicely
  32 time-stamped messages to the HTTP server error log.
  33
  34 For example:
  35
  36    [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3.
  37    [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied.
  38    [Fri Nov 17 21:40:43 1995] test.pl: I'm dying.
  39
  40 =head1 REDIRECTING ERROR MESSAGES
  41
  42 By default, error messages are sent to STDERR.  Most HTTPD servers
  43 direct STDERR to the server's error log.  Some applications may wish
  44 to keep private error logs, distinct from the server's error log, or
  45 they may wish to direct error messages to STDOUT so that the browser
  46 will receive them.
  47
  48 The C<carpout()> function is provided for this purpose.  Since
  49 carpout() is not exported by default, you must import it explicitly by
  50 saying
  51
  52    use CGI::Carp qw(carpout);
  53
  54 The carpout() function requires one argument, which should be a
  55 reference to an open filehandle for writing errors.  It should be
  56 called in a C<BEGIN> block at the top of the CGI application so that
  57 compiler errors will be caught.  Example:
  58
  59    BEGIN {
  60      use CGI::Carp qw(carpout);
  61      open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or
  62        die("Unable to open mycgi-log: $!\n");
  63      carpout(LOG);
  64    }
  65
  66 carpout() does not handle file locking on the log for you at this point.
  67
  68 The real STDERR is not closed -- it is moved to SAVEERR.  Some
  69 servers, when dealing with CGI scripts, close their connection to the
  70 browser when the script closes STDOUT and STDERR.  SAVEERR is used to
  71 prevent this from happening prematurely.
  72
  73 You can pass filehandles to carpout() in a variety of ways.  The "correct"
  74 way according to Tom Christiansen is to pass a reference to a filehandle
  75 GLOB:
  76
  77     carpout(\*LOG);
  78
  79 This looks weird to mere mortals however, so the following syntaxes are
  80 accepted as well:
  81
  82     carpout(LOG);
  83     carpout(main::LOG);
  84     carpout(main'LOG);
  85     carpout(\LOG);
  86     carpout(\'main::LOG');
  87
  88     ... and so on
  89
  90 Use of carpout() is not great for performance, so it is recommended
  91 for debugging purposes or for moderate-use applications.  A future
  92 version of this module may delay redirecting STDERR until one of the
  93 CGI::Carp methods is called to prevent the performance hit.
  94
  95 =head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
  96
  97 If you want to send fatal (die, confess) errors to the browser, ask to
  98 import the special "fatalsToBrowser" subroutine:
  99
 100     use CGI::Carp qw(fatalsToBrowser);
 101     die "Bad error here";
 102
 103 Fatal errors will now be echoed to the browser as well as to the log.  CGI::Carp
 104 arranges to send a minimal HTTP header to the browser so that even errors that
 105 occur in the early compile phase will be seen.
 106 Nonfatal errors will still be directed to the log file only (unless redirected
 107 with carpout).
 108
 109 =head1 CHANGE LOG
 110
 111 1.05 carpout() added and minor corrections by Marc Hedlund
 112      <hedlund@best.com> on 11/26/95.
 113
 114 1.06 fatalsToBrowser() no longer aborts for fatal errors within
 115      eval() statements.
 116
 117 =head1 AUTHORS
 118
 119 Lincoln D. Stein <lstein@genome.wi.mit.edu>.  Feel free to redistribute
 120 this under the Perl Artistic License.
 121
 122
 123 =head1 SEE ALSO
 124
 125 Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
 126 CGI::Response
 127
 128 =cut
 129
 130 require 5.000;
 131 use Exporter;
 132 use Carp;
 133
 134 @ISA = qw(Exporter);
 135 @EXPORT = qw(confess croak carp);
 136 @EXPORT_OK = qw(carpout fatalsToBrowser);
 137
 138 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 139 $main::SIG{__DIE__}=\&CGI::Carp::die;
 140 $CGI::Carp::VERSION = '1.06';
 141
 142 # fancy import routine detects and handles 'errorWrap' specially.
 143 sub import {
 144     my $pkg = shift;
 145     my(%routines);
 146     grep($routines{$_}++,@_);
 147     $WRAP++ if $routines{'fatalsToBrowser'};
 148     my($oldlevel) = $Exporter::ExportLevel;
 149     $Exporter::ExportLevel = 1;
 150     Exporter::import($pkg,keys %routines);
 151     $Exporter::ExportLevel = $oldlevel;
 152 }
 153
 154 # These are the originals
 155 sub realwarn { warn(@_); }
 156 sub realdie { die(@_); }
 157
 158 sub id {
 159     my $level = shift;
 160     my($pack,$file,$line,$sub) = caller($level);
 161     my($id) = $file=~m|([^/]+)$|;
 162     return ($file,$line,$id);
 163 }
 164
 165 sub stamp {
 166     my $time = scalar(localtime);
 167     my $frame = 0;
 168     my ($id,$pack,$file);
 169     do {
 170         $id = $file;
 171         ($pack,$file) = caller($frame++);
 172     } until !$file;
 173     ($id) = $id=~m|([^/]+)$|;
 174     return "[$time] $id: ";
 175 }
 176
 177 sub warn {
 178     my $message = shift;
 179     my($file,$line,$id) = id(1);
 180     $message .= " at $file line $line.\n" unless $message=~/\n$/;
 181     my $stamp = stamp;
 182     $message=~s/^/$stamp/gm;
 183     realwarn $message;
 184 }
 185
 186 sub die {
 187     my $message = shift;
 188     my $time = scalar(localtime);
 189     my($file,$line,$id) = id(1);
 190     return undef if $file=~/^\(eval/;
 191     $message .= " at $file line $line.\n" unless $message=~/\n$/;
 192     &fatalsToBrowser($message) if $WRAP;
 193     my $stamp = stamp;
 194     $message=~s/^/$stamp/gm;
 195     realdie $message;
 196 }
 197
 198 # Avoid generating "subroutine redefined" warnings with the following
 199 # hack:
 200 {
 201     local $^W=0;
 202     eval <<EOF;
 203 sub confess { CGI::Carp::die Carp::longmess \@_; }
 204 sub croak { CGI::Carp::die Carp::shortmess \@_; }
 205 sub carp { CGI::Carp::warn Carp::shortmess \@_; }
 206 EOF
 207     ;
 208 }
 209
 210 # We have to be ready to accept a filehandle as a reference
 211 # or a string.
 212 sub carpout {
 213     my($in) = @_;
 214     $in = $$in if ref($in); # compatability with Marc's method;
 215     my($no) = fileno($in);
 216     unless (defined($no)) {
 217         my($package) = caller;
 218         my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in";
 219         $no = fileno($handle);
 220     }
 221     die "Invalid filehandle $in\n" unless $no;
 222
 223     open(SAVEERR, ">&STDERR");
 224     open(STDERR, ">&$no") or
 225         ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
 226 }
 227
 228 # headers
 229 sub fatalsToBrowser {
 230     my($msg) = @_;
 231     $msg=~s/>/&gt;/g;
 232     $msg=~s/</&lt;/g;
 233     print STDOUT "Content-type: text/html\n\n";
 234     print STDOUT <<END;
 235 <H1>Software error:</H1>
 236 <CODE>$msg</CODE>
 237 <P>
 238 Please send mail to this site's webmaster for help.
 239 END
 240 }
 241
 242 1;