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 | ||
71f3e297 JH |
17 | use CGI::Carp qw(cluck); |
18 | cluck "I wouldn't do that if I were you"; | |
19 | ||
20 | use CGI::Carp qw(fatalsToBrowser); | |
21 | die "Fatal error messages are now sent to browser"; | |
22 | ||
54310121 | 23 | =head1 DESCRIPTION |
24 | ||
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 | |
28 | the usual | |
29 | ||
30 | use Carp; | |
31 | ||
32 | with | |
33 | ||
34 | use CGI::Carp | |
35 | ||
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. | |
39 | ||
40 | For example: | |
41 | ||
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. | |
45 | ||
46 | =head1 REDIRECTING ERROR MESSAGES | |
47 | ||
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 | |
52 | will receive them. | |
53 | ||
54 | The C<carpout()> function is provided for this purpose. Since | |
55 | carpout() is not exported by default, you must import it explicitly by | |
56 | saying | |
57 | ||
58 | use CGI::Carp qw(carpout); | |
59 | ||
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: | |
64 | ||
65 | BEGIN { | |
66 | use CGI::Carp qw(carpout); | |
67 | open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or | |
68 | die("Unable to open mycgi-log: $!\n"); | |
69 | carpout(LOG); | |
70 | } | |
71 | ||
72 | carpout() does not handle file locking on the log for you at this point. | |
73 | ||
ba056755 | 74 | The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR. Some |
54310121 | 75 | servers, when dealing with CGI scripts, close their connection to the |
ba056755 | 76 | browser when the script closes STDOUT and STDERR. CGI::Carp::SAVEERR is there to |
54310121 | 77 | prevent this from happening prematurely. |
78 | ||
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 | |
81 | GLOB: | |
82 | ||
83 | carpout(\*LOG); | |
84 | ||
85 | This looks weird to mere mortals however, so the following syntaxes are | |
86 | accepted as well: | |
87 | ||
88 | carpout(LOG); | |
89 | carpout(main::LOG); | |
90 | carpout(main'LOG); | |
91 | carpout(\LOG); | |
92 | carpout(\'main::LOG'); | |
93 | ||
94 | ... and so on | |
95 | ||
424ec8fa GS |
96 | FileHandle and other objects work as well. |
97 | ||
54310121 | 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. | |
102 | ||
103 | =head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW | |
104 | ||
55b5d700 | 105 | If you want to send fatal (die, confess) errors to the browser, ask to |
54310121 | 106 | import the special "fatalsToBrowser" subroutine: |
107 | ||
108 | use CGI::Carp qw(fatalsToBrowser); | |
109 | die "Bad error here"; | |
110 | ||
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 | |
115 | with carpout). | |
116 | ||
55b5d700 SP |
117 | Note that fatalsToBrowser does B<not> work with mod_perl version 2.0 |
118 | and higher. | |
119 | ||
424ec8fa GS |
120 | =head2 Changing the default message |
121 | ||
122 | By default, the software error message is followed by a note to | |
123 | contact the Webmaster by e-mail with the time and date of the error. | |
124 | If this message is not to your liking, you can change it using the | |
125 | set_message() routine. This is not imported by default; you should | |
126 | import it on the use() line: | |
127 | ||
128 | use CGI::Carp qw(fatalsToBrowser set_message); | |
129 | set_message("It's not a bug, it's a feature!"); | |
130 | ||
131 | You may also pass in a code reference in order to create a custom | |
132 | error message. At run time, your code will be called with the text | |
133 | of the error message that caused the script to die. Example: | |
134 | ||
135 | use CGI::Carp qw(fatalsToBrowser set_message); | |
136 | BEGIN { | |
137 | sub handle_errors { | |
138 | my $msg = shift; | |
139 | print "<h1>Oh gosh</h1>"; | |
b2d0d414 | 140 | print "<p>Got an error: $msg</p>"; |
424ec8fa GS |
141 | } |
142 | set_message(\&handle_errors); | |
143 | } | |
144 | ||
145 | In order to correctly intercept compile-time errors, you should call | |
146 | set_message() from within a BEGIN{} block. | |
147 | ||
6b4ac661 JH |
148 | =head1 MAKING WARNINGS APPEAR AS HTML COMMENTS |
149 | ||
150 | It is now also possible to make non-fatal errors appear as HTML | |
151 | comments embedded in the output of your program. To enable this | |
152 | feature, export the new "warningsToBrowser" subroutine. Since sending | |
153 | warnings to the browser before the HTTP headers have been sent would | |
154 | cause an error, any warnings are stored in an internal buffer until | |
155 | you call the warningsToBrowser() subroutine with a true argument: | |
156 | ||
157 | use CGI::Carp qw(fatalsToBrowser warningsToBrowser); | |
158 | use CGI qw(:standard); | |
159 | print header(); | |
160 | warningsToBrowser(1); | |
161 | ||
162 | You may also give a false argument to warningsToBrowser() to prevent | |
163 | warnings from being sent to the browser while you are printing some | |
164 | content where HTML comments are not allowed: | |
165 | ||
166 | warningsToBrowser(0); # disable warnings | |
b2d0d414 | 167 | print "<script type=\"text/javascript\"><!--\n"; |
6b4ac661 | 168 | print_some_javascript_code(); |
b2d0d414 | 169 | print "//--></script>\n"; |
6b4ac661 JH |
170 | warningsToBrowser(1); # re-enable warnings |
171 | ||
172 | Note: In this respect warningsToBrowser() differs fundamentally from | |
173 | fatalsToBrowser(), which you should never call yourself! | |
174 | ||
188ba755 JH |
175 | =head1 OVERRIDING THE NAME OF THE PROGRAM |
176 | ||
177 | CGI::Carp includes the name of the program that generated the error or | |
178 | warning in the messages written to the log and the browser window. | |
179 | Sometimes, Perl can get confused about what the actual name of the | |
180 | executed program was. In these cases, you can override the program | |
181 | name that CGI::Carp will use for all messages. | |
182 | ||
183 | The quick way to do that is to tell CGI::Carp the name of the program | |
184 | in its use statement. You can do that by adding | |
185 | "name=cgi_carp_log_name" to your "use" statement. For example: | |
186 | ||
187 | use CGI::Carp qw(name=cgi_carp_log_name); | |
188 | ||
189 | . If you want to change the program name partway through the program, | |
190 | you can use the C<set_progname()> function instead. It is not | |
191 | exported by default, you must import it explicitly by saying | |
192 | ||
193 | use CGI::Carp qw(set_progname); | |
194 | ||
195 | Once you've done that, you can change the logged name of the program | |
196 | at any time by calling | |
197 | ||
198 | set_progname(new_program_name); | |
199 | ||
200 | You can set the program back to the default by calling | |
201 | ||
202 | set_progname(undef); | |
203 | ||
204 | Note that this override doesn't happen until after the program has | |
205 | compiled, so any compile-time errors will still show up with the | |
206 | non-overridden program name | |
207 | ||
54310121 | 208 | =head1 CHANGE LOG |
209 | ||
c29edf6c SP |
210 | 1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp |
211 | not behaving correctly in an eval() context. | |
212 | ||
54310121 | 213 | 1.05 carpout() added and minor corrections by Marc Hedlund |
214 | <hedlund@best.com> on 11/26/95. | |
215 | ||
216 | 1.06 fatalsToBrowser() no longer aborts for fatal errors within | |
217 | eval() statements. | |
218 | ||
424ec8fa GS |
219 | 1.08 set_message() added and carpout() expanded to allow for FileHandle |
220 | objects. | |
221 | ||
222 | 1.09 set_message() now allows users to pass a code REFERENCE for | |
223 | really custom error messages. croak and carp are now | |
224 | exported by default. Thanks to Gunther Birznieks for the | |
225 | patches. | |
226 | ||
227 | 1.10 Patch from Chris Dean (ctdean@cogit.com) to allow | |
228 | module to run correctly under mod_perl. | |
229 | ||
71f3e297 JH |
230 | 1.11 Changed order of > and < escapes. |
231 | ||
232 | 1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning. | |
233 | ||
234 | 1.13 Added cluck() to make the module orthogonal with Carp. | |
6b4ac661 JH |
235 | More mod_perl related fixes. |
236 | ||
237 | 1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi): Added | |
238 | warningsToBrowser(). Replaced <CODE> tags with <PRE> in | |
239 | fatalsToBrowser() output. | |
71f3e297 | 240 | |
b2d0d414 | 241 | 1.23 ineval() now checks both $^S and inspects the message for the "eval" pattern |
3c4b39be | 242 | (hack alert!) in order to accommodate various combinations of Perl and |
b2d0d414 JH |
243 | mod_perl. |
244 | ||
188ba755 JH |
245 | 1.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support |
246 | for overriding program name. | |
247 | ||
1c87da1d JH |
248 | 1.26 Replaced CORE::GLOBAL::die with the evil $SIG{__DIE__} because the |
249 | former isn't working in some people's hands. There is no such thing | |
250 | as reliable exception handling in Perl. | |
251 | ||
2ed511ec RGS |
252 | 1.27 Replaced tell STDOUT with bytes=tell STDOUT. |
253 | ||
54310121 | 254 | =head1 AUTHORS |
255 | ||
b2d0d414 | 256 | Copyright 1995-2002, Lincoln D. Stein. All rights reserved. |
71f3e297 JH |
257 | |
258 | This library is free software; you can redistribute it and/or modify | |
259 | it under the same terms as Perl itself. | |
54310121 | 260 | |
71f3e297 | 261 | Address bug reports and comments to: lstein@cshl.org |
54310121 | 262 | |
263 | =head1 SEE ALSO | |
264 | ||
265 | Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form, | |
266 | CGI::Response | |
188ba755 JH |
267 | if (defined($CGI::Carp::PROGNAME)) |
268 | { | |
269 | $file = $CGI::Carp::PROGNAME; | |
270 | } | |
54310121 | 271 | |
272 | =cut | |
273 | ||
274 | require 5.000; | |
275 | use Exporter; | |
3acbd4f5 | 276 | #use Carp; |
1c87da1d JH |
277 | BEGIN { |
278 | require Carp; | |
279 | *CORE::GLOBAL::die = \&CGI::Carp::die; | |
280 | } | |
281 | ||
7f16a916 | 282 | use File::Spec; |
54310121 | 283 | |
284 | @ISA = qw(Exporter); | |
285 | @EXPORT = qw(confess croak carp); | |
1c87da1d | 286 | @EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_progname cluck ^name= die); |
3538e1d5 | 287 | |
54310121 | 288 | $main::SIG{__WARN__}=\&CGI::Carp::warn; |
1c87da1d | 289 | |
29ddc2a4 | 290 | $CGI::Carp::VERSION = '1.29'; |
424ec8fa | 291 | $CGI::Carp::CUSTOM_MSG = undef; |
54310121 | 292 | |
1c87da1d | 293 | |
54310121 | 294 | # fancy import routine detects and handles 'errorWrap' specially. |
295 | sub import { | |
296 | my $pkg = shift; | |
297 | my(%routines); | |
188ba755 | 298 | my(@name); |
188ba755 JH |
299 | if (@name=grep(/^name=/,@_)) |
300 | { | |
301 | my($n) = (split(/=/,$name[0]))[1]; | |
302 | set_progname($n); | |
303 | @_=grep(!/^name=/,@_); | |
304 | } | |
305 | ||
424ec8fa GS |
306 | grep($routines{$_}++,@_,@EXPORT); |
307 | $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'}; | |
6b4ac661 | 308 | $WARN++ if $routines{'warningsToBrowser'}; |
54310121 | 309 | my($oldlevel) = $Exporter::ExportLevel; |
310 | $Exporter::ExportLevel = 1; | |
311 | Exporter::import($pkg,keys %routines); | |
312 | $Exporter::ExportLevel = $oldlevel; | |
1c87da1d JH |
313 | $main::SIG{__DIE__} =\&CGI::Carp::die if $routines{'fatalsToBrowser'}; |
314 | # $pkg->export('CORE::GLOBAL','die'); | |
54310121 | 315 | } |
316 | ||
317 | # These are the originals | |
9014bb8e GS |
318 | sub realwarn { CORE::warn(@_); } |
319 | sub realdie { CORE::die(@_); } | |
54310121 | 320 | |
321 | sub id { | |
322 | my $level = shift; | |
323 | my($pack,$file,$line,$sub) = caller($level); | |
7f16a916 | 324 | my($dev,$dirs,$id) = File::Spec->splitpath($file); |
54310121 | 325 | return ($file,$line,$id); |
326 | } | |
327 | ||
328 | sub stamp { | |
329 | my $time = scalar(localtime); | |
330 | my $frame = 0; | |
ac734d8b | 331 | my ($id,$pack,$file,$dev,$dirs); |
188ba755 JH |
332 | if (defined($CGI::Carp::PROGNAME)) { |
333 | $id = $CGI::Carp::PROGNAME; | |
334 | } else { | |
335 | do { | |
336 | $id = $file; | |
337 | ($pack,$file) = caller($frame++); | |
338 | } until !$file; | |
339 | } | |
7f16a916 | 340 | ($dev,$dirs,$id) = File::Spec->splitpath($id); |
54310121 | 341 | return "[$time] $id: "; |
342 | } | |
343 | ||
188ba755 JH |
344 | sub set_progname { |
345 | $CGI::Carp::PROGNAME = shift; | |
346 | return $CGI::Carp::PROGNAME; | |
347 | } | |
348 | ||
349 | ||
54310121 | 350 | sub warn { |
351 | my $message = shift; | |
352 | my($file,$line,$id) = id(1); | |
353 | $message .= " at $file line $line.\n" unless $message=~/\n$/; | |
6b4ac661 | 354 | _warn($message) if $WARN; |
54310121 | 355 | my $stamp = stamp; |
356 | $message=~s/^/$stamp/gm; | |
357 | realwarn $message; | |
358 | } | |
359 | ||
6b4ac661 JH |
360 | sub _warn { |
361 | my $msg = shift; | |
362 | if ($EMIT_WARNINGS) { | |
363 | # We need to mangle the message a bit to make it a valid HTML | |
364 | # comment. This is done by substituting similar-looking ISO | |
365 | # 8859-1 characters for <, > and -. This is a hack. | |
366 | $msg =~ tr/<>-/\253\273\255/; | |
367 | chomp $msg; | |
368 | print STDOUT "<!-- warning: $msg -->\n"; | |
369 | } else { | |
370 | push @WARNINGS, $msg; | |
371 | } | |
372 | } | |
373 | ||
6b4ac661 | 374 | |
424ec8fa GS |
375 | # The mod_perl package Apache::Registry loads CGI programs by calling |
376 | # eval. These evals don't count when looking at the stack backtrace. | |
377 | sub _longmess { | |
378 | my $message = Carp::longmess(); | |
29ddc2a4 | 379 | $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s |
8f3ccfa2 JH |
380 | if exists $ENV{MOD_PERL}; |
381 | return $message; | |
382 | } | |
383 | ||
384 | sub ineval { | |
385 | (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m | |
424ec8fa GS |
386 | } |
387 | ||
54310121 | 388 | sub die { |
13548fdf | 389 | my ($arg,@rest) = @_; |
c29edf6c SP |
390 | |
391 | if ( ineval() ) { | |
392 | if (!ref($arg)) { | |
393 | $arg = join("",($arg,@rest)) || "Died"; | |
394 | my($file,$line,$id) = id(1); | |
395 | $arg .= " at $file line $line.\n" unless $arg=~/\n$/; | |
396 | realdie($arg); | |
397 | } | |
398 | else { | |
399 | realdie($arg,@rest); | |
400 | } | |
401 | } | |
13548fdf | 402 | |
8f3ccfa2 | 403 | if (!ref($arg)) { |
13548fdf | 404 | $arg = join("", ($arg,@rest)); |
8f3ccfa2 JH |
405 | my($file,$line,$id) = id(1); |
406 | $arg .= " at $file line $line." unless $arg=~/\n$/; | |
407 | &fatalsToBrowser($arg) if $WRAP; | |
408 | if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) { | |
409 | my $stamp = stamp; | |
410 | $arg=~s/^/$stamp/gm; | |
411 | } | |
412 | if ($arg !~ /\n$/) { | |
413 | $arg .= "\n"; | |
414 | } | |
415 | } | |
416 | realdie $arg; | |
54310121 | 417 | } |
418 | ||
424ec8fa GS |
419 | sub set_message { |
420 | $CGI::Carp::CUSTOM_MSG = shift; | |
421 | return $CGI::Carp::CUSTOM_MSG; | |
422 | } | |
423 | ||
2371fea9 JH |
424 | sub confess { CGI::Carp::die Carp::longmess @_; } |
425 | sub croak { CGI::Carp::die Carp::shortmess @_; } | |
426 | sub carp { CGI::Carp::warn Carp::shortmess @_; } | |
427 | sub cluck { CGI::Carp::warn Carp::longmess @_; } | |
54310121 | 428 | |
429 | # We have to be ready to accept a filehandle as a reference | |
430 | # or a string. | |
431 | sub carpout { | |
432 | my($in) = @_; | |
424ec8fa | 433 | my($no) = fileno(to_filehandle($in)); |
71f3e297 | 434 | realdie("Invalid filehandle $in\n") unless defined $no; |
54310121 | 435 | |
436 | open(SAVEERR, ">&STDERR"); | |
437 | open(STDERR, ">&$no") or | |
438 | ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); | |
439 | } | |
440 | ||
6b4ac661 JH |
441 | sub warningsToBrowser { |
442 | $EMIT_WARNINGS = @_ ? shift : 1; | |
443 | _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS; | |
444 | } | |
445 | ||
54310121 | 446 | # headers |
447 | sub fatalsToBrowser { | |
8f3ccfa2 JH |
448 | my($msg) = @_; |
449 | $msg=~s/&/&/g; | |
450 | $msg=~s/>/>/g; | |
451 | $msg=~s/</</g; | |
452 | $msg=~s/\"/"/g; | |
453 | my($wm) = $ENV{SERVER_ADMIN} ? | |
454 | qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] : | |
455 | "this site's webmaster"; | |
456 | my ($outer_message) = <<END; | |
424ec8fa GS |
457 | For help, please send mail to $wm, giving this error message |
458 | and the time and date of the error. | |
459 | END | |
8f3ccfa2 JH |
460 | ; |
461 | my $mod_perl = exists $ENV{MOD_PERL}; | |
8f3ccfa2 | 462 | |
8f3ccfa2 JH |
463 | if ($CUSTOM_MSG) { |
464 | if (ref($CUSTOM_MSG) eq 'CODE') { | |
0c45d622 JH |
465 | print STDOUT "Content-type: text/html\n\n" |
466 | unless $mod_perl; | |
8f3ccfa2 JH |
467 | &$CUSTOM_MSG($msg); # nicer to perl 5.003 users |
468 | return; | |
469 | } else { | |
470 | $outer_message = $CUSTOM_MSG; | |
424ec8fa | 471 | } |
8f3ccfa2 | 472 | } |
1c87da1d | 473 | |
8f3ccfa2 | 474 | my $mess = <<END; |
b2d0d414 JH |
475 | <h1>Software error:</h1> |
476 | <pre>$msg</pre> | |
477 | <p> | |
71f3e297 | 478 | $outer_message |
b2d0d414 | 479 | </p> |
54310121 | 480 | END |
8f3ccfa2 | 481 | ; |
1c87da1d | 482 | |
8f3ccfa2 | 483 | if ($mod_perl) { |
741ff09d | 484 | my $r; |
0a9bdad4 | 485 | if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { |
8f3ccfa2 | 486 | $mod_perl = 2; |
741ff09d RGS |
487 | require Apache2::RequestRec; |
488 | require Apache2::RequestIO; | |
489 | require Apache2::RequestUtil; | |
8f3ccfa2 JH |
490 | require APR::Pool; |
491 | require ModPerl::Util; | |
741ff09d RGS |
492 | require Apache2::Response; |
493 | $r = Apache2::RequestUtil->request; | |
494 | } | |
495 | else { | |
496 | $r = Apache->request; | |
8f3ccfa2 | 497 | } |
8f3ccfa2 JH |
498 | # If bytes have already been sent, then |
499 | # we print the message out directly. | |
500 | # Otherwise we make a custom error | |
501 | # handler to produce the doc for us. | |
502 | if ($r->bytes_sent) { | |
503 | $r->print($mess); | |
504 | $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit; | |
71f3e297 | 505 | } else { |
1c87da1d | 506 | # MSIE won't display a custom 500 response unless it is >512 bytes! |
8f3ccfa2 | 507 | if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) { |
1c87da1d | 508 | $mess = "<!-- " . (' ' x 513) . " -->\n$mess"; |
8f3ccfa2 | 509 | } |
1c87da1d | 510 | $r->custom_response(500,$mess); |
71f3e297 | 511 | } |
8f3ccfa2 | 512 | } else { |
2ed511ec RGS |
513 | my $bytes_written = eval{tell STDOUT}; |
514 | if (defined $bytes_written && $bytes_written > 0) { | |
0c45d622 JH |
515 | print STDOUT $mess; |
516 | } | |
517 | else { | |
518 | print STDOUT "Content-type: text/html\n\n"; | |
519 | print STDOUT $mess; | |
520 | } | |
8f3ccfa2 | 521 | } |
13548fdf RGS |
522 | |
523 | warningsToBrowser(1); # emit warnings before dying | |
424ec8fa GS |
524 | } |
525 | ||
526 | # Cut and paste from CGI.pm so that we don't have the overhead of | |
527 | # always loading the entire CGI module. | |
528 | sub to_filehandle { | |
529 | my $thingy = shift; | |
530 | return undef unless $thingy; | |
531 | return $thingy if UNIVERSAL::isa($thingy,'GLOB'); | |
532 | return $thingy if UNIVERSAL::isa($thingy,'FileHandle'); | |
533 | if (!ref($thingy)) { | |
534 | my $caller = 1; | |
535 | while (my $package = caller($caller++)) { | |
536 | my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; | |
537 | return $tmp if defined(fileno($tmp)); | |
538 | } | |
539 | } | |
540 | return undef; | |
54310121 | 541 | } |
542 | ||
543 | 1; |