diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-03-26 07:04:34 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1997-03-26 07:04:34 +1200 |
commit | 54310121b442974721115f93666234a200f5c7e4 (patch) | |
tree | 99b5953030ddf062d77206ac0cf8ac967e7cbd93 /lib/CGI/Carp.pm | |
parent | d03407ef6d8e534a414e9ce92c6c5c8dab664a40 (diff) | |
download | perl-54310121b442974721115f93666234a200f5c7e4.tar.gz |
[inseperable changes from patch from perl-5.003_95 to perl-5.003_86]
[editor's note: this commit was prepared manually so may differ in
minor ways to other inseperable changes commits]
CORE LANGUAGE CHANGES
Title: "Support $ENV{PERL5OPT}"
From: Chip Salzenberg
Files: perl.c pod/perldiag.pod pod/perldelta.pod pod/perlrun.pod
Title: "Implement void context, in which C<wantarray> is undef"
From: Chip Salzenberg
Files: cop.h doop.c dump.c global.sym gv.c op.c op.h perl.c
pod/perlcall.pod pod/perldelta.pod pod/perlfunc.pod
pod/perlguts.pod pod/perlsub.pod pp.c pp_ctl.c pp_hot.c
pp_sys.c proto.h
Title: "Don't look up &AUTOLOAD in @ISA when calling plain function"
From: Chip Salzenberg
Files: global.sym gv.c lib/Text/ParseWords.pm pod/perldelta.pod
pp_hot.c proto.h t/op/method.t
Title: "Allow closures to be constant subroutines"
From: Chip Salzenberg
Files: op.c
Title: "Make C<scalar(reverse)> mean C<scalar(reverse $_)>"
From: Chip Salzenberg
Files: pp.c
Title: "Fix lexical suicide from C<my $x = $x> in sub"
From: Chip Salzenberg
Files: op.c
Title: "Make "Unrecog. char." fatal, and update its doc"
From: Chip Salzenberg
Files: pod/perldiag.pod toke.c
CORE PORTABILITY
Title: "safefree() mismatch"
From: Roderick Schertler
Msg-ID: <21338.859653381@eeyore.ibcinc.com>
Date: Sat, 29 Mar 1997 11:36:21 -0500
Files: util.c
(applied based on p5p patch as commit id 9b9b466fb02dc96c81439bafbb3b2da55238cfd2)
Title: "Win32 update (seven patches)"
From: Gurusamy Sarathy and Nick Ing-Simmons
Files: EXTERN.h MANIFEST win32/Makefile win32/perl.mak
win32/perl.rc win32/perldll.mak win32/makedef.pl
win32/modules.mak win32/win32io.c win32/bin/pl2bat.bat
OTHER CORE CHANGES
Title: "Report PERL* environment variables in -V and perlbug"
From: Chip Salzenberg
Files: perl.c utils/perlbug.PL
Title: "Typo in perl.c: Printing NO_EMBED for perl -V"
From: Gisle Aas
Msg-ID: <199703301922.VAA13509@furubotn.sn.no>
Date: Sun, 30 Mar 1997 21:22:11 +0200
Files: perl.c
(applied based on p5p patch as commit id b6c639e4b1912ad03b9b10ba9518d96bd0a6cfaf)
Title: "Don't let C<$var = $var> untaint $var"
From: Chip Salzenberg
Files: pp_hot.c pp_sys.c sv.h t/op/taint.t
Title: "Fix autoviv bug in C<my $x; ++$x->{KEY}>"
From: Chip Salzenberg
Files: pp_hot.c
Title: "Re: 5.004's new srand() default seed"
From: Hallvard B Furuseth
Msg-ID: <199703302219.AAA20998@bombur2.uio.no>
Date: Mon, 31 Mar 1997 00:19:13 +0200 (MET DST)
Files: pp.c
(applied based on p5p patch as commit id d7d933a26349f945f93b2f0dbf85b773d8ca3219)
Title: "Re: embedded perl and top_env problem "
From: Gurusamy Sarathy
Msg-ID: <199703280031.TAA05711@aatma.engin.umich.edu>
Date: Thu, 27 Mar 1997 19:31:42 -0500
Files: gv.c interp.sym perl.c perl.h pp_ctl.c pp_sys.c scope.h util.c
(applied based on p5p patch as commit id f289f7d2518e7a8a82114282e774adf50fa6ce85)
Title: "Define and use new macro: boolSV()"
From: Tim Bunce
Files: gv.c lib/ExtUtils/typemap os2/os2.c pp.c pp_hot.c pp_sys.c
sv.c sv.h universal.c vms/vms.c
Title: "Re: strict @F"
From: Hallvard B Furuseth
Msg-ID: <199703252110.WAA16038@bombur2.uio.no>
Date: Tue, 25 Mar 1997 22:10:33 +0100 (MET)
Files: toke.c
(applied based on p5p patch as commit id dfd44a5c8c8dd4c001c595debfe73d011a96d844)
Title: "Try harder to identify errors at EOF"
From: Chip Salzenberg
Files: toke.c
Title: "Minor string change in toke.c: 'bareword'"
From: lvirden@cas.org
Msg-ID: <1997Mar27.130247.1911552@hmivax.humgen.upenn.edu>
Date: Thu, 27 Mar 1997 13:02:46 -0500 (EST)
Files: toke.c
(applied based on p5p patch as commit id 9b56c8f8085a9e773ad87c6b3c1d0b5e39dbc348)
Title: "Improve diagnostic on \r in program text"
From: Chip Salzenberg
Files: pod/perldiag.pod toke.c
Title: "Make Sock_size_t typedef work right"
From: Chip Salzenberg
Files: perl.h pp_sys.c
LIBRARY AND EXTENSIONS
Title: "New module constant.pm"
From: Tom Phoenix
Files: MANIFEST lib/constant.pm op.c pp.c t/pragma/constant.t
Title: "Remove chat2"
From: Chip Salzenberg
Files: MANIFEST lib/chat2.inter lib/chat2.pl
Title: "Include CGI.pm 2.32"
From: Chip Salzenberg
Files: MANIFEST eg/cgi/* lib/CGI.pm lib/CGI/Apache.pm
lib/CGI/Carp.pm lib/CGI/Fast.pm lib/CGI/Push.pm
lib/CGI/Switch.pm
UTILITIES
Title: "Tom C's Pod::Html and html tools, as of 30 March 97"
From: Chip Salzenberg
Files: MANIFEST installhtml lib/Pod/Html.pm pod/pod2html.PL
Title: "Fix path bugs in installhtml"
From: Robin Barker <rmb1@cise.npl.co.uk>
Msg-ID: <3180.9703270906@tempest.cise.npl.co.uk>
Date: Thu, 27 Mar 97 09:06:14 GMT
Files: installhtml
Title: "Make perlbug say that it's only for core Perl bugs"
From: Chip Salzenberg
Files: utils/perlbug.PL
DOCUMENTATION
Title: "Document autouse and constant; update diagnostics"
From: Chip Salzenberg
Files: pod/perldelta.pod
Title: "Suggest to upgraders that they try '-w' again"
From: Hallvard B Furuseth
Msg-ID: <199703251901.UAA15982@bombur2.uio.no>
Date: Tue, 25 Mar 1997 20:01:26 +0100 (MET)
Files: pod/perldelta.pod
(applied based on p5p patch as commit id 4176c059b9ba6b022e99c44270434a5c3e415b73)
Title: "Improve and update documentation of constant subs"
From: Tom Phoenix <rootbeer@teleport.com>
Msg-ID: <Pine.GSO.3.96.970331122546.14185C-100000@kelly.teleport.com>
Date: Mon, 31 Mar 1997 13:05:54 -0800 (PST)
Files: pod/perlsub.pod
Title: "Improve documentation of C<return>"
From: Chip Salzenberg
Files: pod/perlfunc.pod pod/perlsub.pod
Title: "perlfunc.pod patch"
From: Gisle Aas
Msg-ID: <199703262159.WAA17531@furubotn.sn.no>
Date: Wed, 26 Mar 1997 22:59:23 +0100
Files: pod/perlfunc.pod
(applied based on p5p patch as commit id 35a731fcbcd7860eb497d6598f3f77b8746319c4)
Title: "Use 'while (defined($x = <>)) {}', per <gnat@frii.com>"
From: Chip Salzenberg
Files: configpm lib/Term/Cap.pm perlsh pod/perlipc.pod pod/perlop.pod
pod/perlsub.pod pod/perlsyn.pod pod/perltrap.pod
pod/perlvar.pod win32/bin/search.bat
Title: "Document and test C<%> behavior with negative operands"
From: Chip Salzenberg
Files: pod/perlop.pod t/op/arith.t
Title: "Update docs on $]"
From: Chip Salzenberg
Files: pod/perlvar.pod
Title: "perlvar.pod patch"
From: Gisle Aas
Msg-ID: <199703261254.NAA10237@bergen.sn.no>
Date: Wed, 26 Mar 1997 13:54:00 +0100
Files: pod/perlvar.pod
(applied based on p5p patch as commit id 0aa182cb0caa3829032904b9754807b1b7418509)
Title: "Fix example of C<or> vs. C<||>"
From: Chip Salzenberg
Files: pod/perlsyn.pod
Title: "Pod usage and spelling patch"
From: Larry W. Virden
Files: pod/*.pod
Title: "Pod updates"
From: "Cary D. Renzema" <caryr@mxim.com>
Msg-ID: <199703262353.PAA01819@macs.mxim.com>
Date: Wed, 26 Mar 1997 15:53:22 -0800 (PST)
Files: pod/*.pod
(applied based on p5p patch as commit id 5695b28edc67a3f45e8a0f25755d07afef3660ac)
Diffstat (limited to 'lib/CGI/Carp.pm')
-rw-r--r-- | lib/CGI/Carp.pm | 242 |
1 files changed, 242 insertions, 0 deletions
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm new file mode 100644 index 0000000000..4cd79467fd --- /dev/null +++ b/lib/CGI/Carp.pm @@ -0,0 +1,242 @@ +package CGI::Carp; + +=head1 NAME + +B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log + +=head1 SYNOPSIS + + use CGI::Carp; + + croak "We're outta here!"; + confess "It was my fault: $!"; + carp "It was your fault!"; + warn "I'm confused"; + die "I'm dying.\n"; + +=head1 DESCRIPTION + +CGI scripts have a nasty habit of leaving warning messages in the error +logs that are neither time stamped nor fully identified. Tracking down +the script that caused the error is a pain. This fixes that. Replace +the usual + + use Carp; + +with + + use CGI::Carp + +And the standard warn(), die (), croak(), confess() and carp() calls +will automagically be replaced with functions that write out nicely +time-stamped messages to the HTTP server error log. + +For example: + + [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3. + [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied. + [Fri Nov 17 21:40:43 1995] test.pl: I'm dying. + +=head1 REDIRECTING ERROR MESSAGES + +By default, error messages are sent to STDERR. Most HTTPD servers +direct STDERR to the server's error log. Some applications may wish +to keep private error logs, distinct from the server's error log, or +they may wish to direct error messages to STDOUT so that the browser +will receive them. + +The C<carpout()> function is provided for this purpose. Since +carpout() is not exported by default, you must import it explicitly by +saying + + use CGI::Carp qw(carpout); + +The carpout() function requires one argument, which should be a +reference to an open filehandle for writing errors. It should be +called in a C<BEGIN> block at the top of the CGI application so that +compiler errors will be caught. Example: + + BEGIN { + use CGI::Carp qw(carpout); + open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or + die("Unable to open mycgi-log: $!\n"); + carpout(LOG); + } + +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 +servers, when dealing with CGI scripts, close their connection to the +browser when the script closes STDOUT and STDERR. SAVEERR is used to +prevent this from happening prematurely. + +You can pass filehandles to carpout() in a variety of ways. The "correct" +way according to Tom Christiansen is to pass a reference to a filehandle +GLOB: + + carpout(\*LOG); + +This looks weird to mere mortals however, so the following syntaxes are +accepted as well: + + carpout(LOG); + carpout(main::LOG); + carpout(main'LOG); + carpout(\LOG); + carpout(\'main::LOG'); + + ... and so on + +Use of carpout() is not great for performance, so it is recommended +for debugging purposes or for moderate-use applications. A future +version of this module may delay redirecting STDERR until one of the +CGI::Carp methods is called to prevent the performance hit. + +=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW + +If you want to send fatal (die, confess) errors to the browser, ask to +import the special "fatalsToBrowser" subroutine: + + use CGI::Carp qw(fatalsToBrowser); + die "Bad error here"; + +Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp +arranges to send a minimal HTTP header to the browser so that even errors that +occur in the early compile phase will be seen. +Nonfatal errors will still be directed to the log file only (unless redirected +with carpout). + +=head1 CHANGE LOG + +1.05 carpout() added and minor corrections by Marc Hedlund + <hedlund@best.com> on 11/26/95. + +1.06 fatalsToBrowser() no longer aborts for fatal errors within + eval() statements. + +=head1 AUTHORS + +Lincoln D. Stein <lstein@genome.wi.mit.edu>. Feel free to redistribute +this under the Perl Artistic License. + + +=head1 SEE ALSO + +Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form, +CGI::Response + +=cut + +require 5.000; +use Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(confess croak carp); +@EXPORT_OK = qw(carpout fatalsToBrowser); + +$main::SIG{__WARN__}=\&CGI::Carp::warn; +$main::SIG{__DIE__}=\&CGI::Carp::die; +$CGI::Carp::VERSION = '1.06'; + +# fancy import routine detects and handles 'errorWrap' specially. +sub import { + my $pkg = shift; + my(%routines); + grep($routines{$_}++,@_); + $WRAP++ if $routines{'fatalsToBrowser'}; + my($oldlevel) = $Exporter::ExportLevel; + $Exporter::ExportLevel = 1; + Exporter::import($pkg,keys %routines); + $Exporter::ExportLevel = $oldlevel; +} + +# These are the originals +sub realwarn { warn(@_); } +sub realdie { die(@_); } + +sub id { + my $level = shift; + my($pack,$file,$line,$sub) = caller($level); + my($id) = $file=~m|([^/]+)$|; + return ($file,$line,$id); +} + +sub stamp { + my $time = scalar(localtime); + my $frame = 0; + my ($id,$pack,$file); + do { + $id = $file; + ($pack,$file) = caller($frame++); + } until !$file; + ($id) = $id=~m|([^/]+)$|; + return "[$time] $id: "; +} + +sub warn { + my $message = shift; + my($file,$line,$id) = id(1); + $message .= " at $file line $line.\n" unless $message=~/\n$/; + my $stamp = stamp; + $message=~s/^/$stamp/gm; + realwarn $message; +} + +sub die { + my $message = shift; + my $time = scalar(localtime); + my($file,$line,$id) = id(1); + return undef if $file=~/^\(eval/; + $message .= " at $file line $line.\n" unless $message=~/\n$/; + &fatalsToBrowser($message) if $WRAP; + my $stamp = stamp; + $message=~s/^/$stamp/gm; + realdie $message; +} + +# 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 \@_; } +EOF + ; +} + +# We have to be ready to accept a filehandle as a reference +# or a string. +sub carpout { + my($in) = @_; + $in = $$in if ref($in); # compatability with Marc's method; + my($no) = fileno($in); + unless (defined($no)) { + my($package) = caller; + my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in"; + $no = fileno($handle); + } + die "Invalid filehandle $in\n" unless $no; + + open(SAVEERR, ">&STDERR"); + open(STDERR, ">&$no") or + ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); +} + +# headers +sub fatalsToBrowser { + my($msg) = @_; + $msg=~s/>/>/g; + $msg=~s/</</g; + print STDOUT "Content-type: text/html\n\n"; + print STDOUT <<END; +<H1>Software error:</H1> +<CODE>$msg</CODE> +<P> +Please send mail to this site's webmaster for help. +END +} + +1; |