Commit | Line | Data |
54310121 |
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/>/>/g; |
232 | $msg=~s/</</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; |