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