← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:08 2015

Filename/usr/share/perl5/vendor_perl/CGI/Carp.pm
StatementsExecuted 134 statements in 5.13ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1114.92ms5.37msCGI::Carp::::BEGIN@334CGI::Carp::BEGIN@334
1113.59ms5.23msCGI::Carp::::BEGIN@339CGI::Carp::BEGIN@339
1111.35ms1.40msCGI::Carp::::BEGIN@332CGI::Carp::BEGIN@332
211231µs245µsCGI::Carp::::stampCGI::Carp::stamp
21149µs49µsCGI::Carp::::realwarnCGI::Carp::realwarn
22246µs405µsCGI::Carp::::warnCGI::Carp::warn
21141µs65µsCGI::Carp::::idCGI::Carp::id
11139µs107µsCGI::Carp::::importCGI::Carp::import
0000s0sCGI::Carp::::_longmessCGI::Carp::_longmess
0000s0sCGI::Carp::::_warnCGI::Carp::_warn
0000s0sCGI::Carp::::carpCGI::Carp::carp
0000s0sCGI::Carp::::carpoutCGI::Carp::carpout
0000s0sCGI::Carp::::cluckCGI::Carp::cluck
0000s0sCGI::Carp::::confessCGI::Carp::confess
0000s0sCGI::Carp::::croakCGI::Carp::croak
0000s0sCGI::Carp::::dieCGI::Carp::die
0000s0sCGI::Carp::::fatalsToBrowserCGI::Carp::fatalsToBrowser
0000s0sCGI::Carp::::inevalCGI::Carp::ineval
0000s0sCGI::Carp::::realdieCGI::Carp::realdie
0000s0sCGI::Carp::::set_die_handlerCGI::Carp::set_die_handler
0000s0sCGI::Carp::::set_messageCGI::Carp::set_message
0000s0sCGI::Carp::::set_prognameCGI::Carp::set_progname
0000s0sCGI::Carp::::to_filehandleCGI::Carp::to_filehandle
0000s0sCGI::Carp::::warningsToBrowserCGI::Carp::warningsToBrowser
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package CGI::Carp;
2
3=head1 NAME
4
5B<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
25CGI scripts have a nasty habit of leaving warning messages in the error
26logs that are neither time stamped nor fully identified. Tracking down
27the script that caused the error is a pain. This fixes that. Replace
28the usual
29
30 use Carp;
31
32with
33
34 use CGI::Carp
35
36The standard warn(), die (), croak(), confess() and carp() calls will
37be replaced with functions that write time-stamped messages to the
38HTTP server error log.
39
40For 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
48By default, error messages are sent to STDERR. Most HTTPD servers
49direct STDERR to the server's error log. Some applications may wish
50to keep private error logs, distinct from the server's error log, or
51they may wish to direct error messages to STDOUT so that the browser
52will receive them.
53
54The C<carpout()> function is provided for this purpose. Since
55carpout() is not exported by default, you must import it explicitly by
56saying
57
58 use CGI::Carp qw(carpout);
59
60The carpout() function requires one argument, a reference to an open
61filehandle for writing errors. It should be called in a C<BEGIN>
62block at the top of the CGI application so that compiler errors will
63be 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
72carpout() does not handle file locking on the log for you at this
73point. Also, note that carpout() does not work with in-memory file
74handles, although a patch would be welcome to address that.
75
76The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR.
77Some servers, when dealing with CGI scripts, close their connection to
78the browser when the script closes STDOUT and STDERR.
79CGI::Carp::SAVEERR is there to prevent this from happening
80prematurely.
81
82You can pass filehandles to carpout() in a variety of ways. The "correct"
83way according to Tom Christiansen is to pass a reference to a filehandle
84GLOB:
85
86 carpout(\*LOG);
87
88This looks weird to mere mortals however, so the following syntaxes are
89accepted as well:
90
91 carpout(LOG);
92 carpout(main::LOG);
93 carpout(main'LOG);
94 carpout(\LOG);
95 carpout(\'main::LOG');
96
97 ... and so on
98
99FileHandle and other objects work as well.
100
101Use of carpout() is not great for performance, so it is recommended
102for debugging purposes or for moderate-use applications. A future
103version of this module may delay redirecting STDERR until one of the
104CGI::Carp methods is called to prevent the performance hit.
105
106=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
107
108If you want to send fatal (die, confess) errors to the browser, import
109the special "fatalsToBrowser" subroutine:
110
111 use CGI::Carp qw(fatalsToBrowser);
112 die "Bad error here";
113
114Fatal errors will now be echoed to the browser as well as to the log.
115CGI::Carp arranges to send a minimal HTTP header to the browser so
116that even errors that occur in the early compile phase will be seen.
117Nonfatal errors will still be directed to the log file only (unless
118redirected with carpout).
119
120Note that fatalsToBrowser may B<not> work well with mod_perl version 2.0
121and higher.
122
123=head2 Changing the default message
124
125By default, the software error message is followed by a note to
126contact the Webmaster by e-mail with the time and date of the error.
127If this message is not to your liking, you can change it using the
128set_message() routine. This is not imported by default; you should
129import it on the use() line:
130
131 use CGI::Carp qw(fatalsToBrowser set_message);
132 set_message("It's not a bug, it's a feature!");
133
134You may also pass in a code reference in order to create a custom
135error message. At run time, your code will be called with the text
136of the error message that caused the script to die. Example:
137
138 use CGI::Carp qw(fatalsToBrowser set_message);
139 BEGIN {
140 sub handle_errors {
141 my $msg = shift;
142 print "<h1>Oh gosh</h1>";
143 print "<p>Got an error: $msg</p>";
144 }
145 set_message(\&handle_errors);
146 }
147
148In order to correctly intercept compile-time errors, you should call
149set_message() from within a BEGIN{} block.
150
151=head1 DOING MORE THAN PRINTING A MESSAGE IN THE EVENT OF PERL ERRORS
152
153If fatalsToBrowser in conjunction with set_message does not provide
154you with all of the functionality you need, you can go one step
155further by specifying a function to be executed any time a script
156calls "die", has a syntax error, or dies unexpectedly at runtime
157with a line like "undef->explode();".
158
159 use CGI::Carp qw(set_die_handler);
160 BEGIN {
161 sub handle_errors {
162 my $msg = shift;
163 print "content-type: text/html\n\n";
164 print "<h1>Oh gosh</h1>";
165 print "<p>Got an error: $msg</p>";
166
167 #proceed to send an email to a system administrator,
168 #write a detailed message to the browser and/or a log,
169 #etc....
170 }
171 set_die_handler(\&handle_errors);
172 }
173
174Notice that if you use set_die_handler(), you must handle sending
175HTML headers to the browser yourself if you are printing a message.
176
177If you use set_die_handler(), you will most likely interfere with
178the behavior of fatalsToBrowser, so you must use this or that, not
179both.
180
181Using set_die_handler() sets SIG{__DIE__} (as does fatalsToBrowser),
182and there is only one SIG{__DIE__}. This means that if you are
183attempting to set SIG{__DIE__} yourself, you may interfere with
184this module's functionality, or this module may interfere with
185your module's functionality.
186
187=head2 SUPPRESSING PERL ERRORS APPEARING IN THE BROWSER WINDOW
188
189A problem sometimes encountered when using fatalsToBrowser is
190when a C<die()> is done inside an C<eval> body or expression.
191Even though the
192fatalsToBrower support takes precautions to avoid this,
193you still may get the error message printed to STDOUT.
194This may have some undesireable effects when the purpose of doing the
195eval is to determine which of several algorithms is to be used.
196
197By setting C<$CGI::Carp::TO_BROWSER> to 0 you can suppress printing
198the C<die> messages but without all of the complexity of using
199C<set_die_handler>. You can localize this effect to inside C<eval>
200bodies if this is desireable: For example:
201
202 eval {
203 local $CGI::Carp::TO_BROWSER = 0;
204 die "Fatal error messages not sent browser"
205 }
206 # $@ will contain error message
207
208
209=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
210
211It is also possible to make non-fatal errors appear as HTML comments
212embedded in the output of your program. To enable this feature,
213export the new "warningsToBrowser" subroutine. Since sending warnings
214to the browser before the HTTP headers have been sent would cause an
215error, any warnings are stored in an internal buffer until you call
216the warningsToBrowser() subroutine with a true argument:
217
218 use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
219 use CGI qw(:standard);
220 print header();
221 warningsToBrowser(1);
222
223You may also give a false argument to warningsToBrowser() to prevent
224warnings from being sent to the browser while you are printing some
225content where HTML comments are not allowed:
226
227 warningsToBrowser(0); # disable warnings
228 print "<script type=\"text/javascript\"><!--\n";
229 print_some_javascript_code();
230 print "//--></script>\n";
231 warningsToBrowser(1); # re-enable warnings
232
233Note: In this respect warningsToBrowser() differs fundamentally from
234fatalsToBrowser(), which you should never call yourself!
235
236=head1 OVERRIDING THE NAME OF THE PROGRAM
237
238CGI::Carp includes the name of the program that generated the error or
239warning in the messages written to the log and the browser window.
240Sometimes, Perl can get confused about what the actual name of the
241executed program was. In these cases, you can override the program
242name that CGI::Carp will use for all messages.
243
244The quick way to do that is to tell CGI::Carp the name of the program
245in its use statement. You can do that by adding
246"name=cgi_carp_log_name" to your "use" statement. For example:
247
248 use CGI::Carp qw(name=cgi_carp_log_name);
249
250. If you want to change the program name partway through the program,
251you can use the C<set_progname()> function instead. It is not
252exported by default, you must import it explicitly by saying
253
254 use CGI::Carp qw(set_progname);
255
256Once you've done that, you can change the logged name of the program
257at any time by calling
258
259 set_progname(new_program_name);
260
261You can set the program back to the default by calling
262
263 set_progname(undef);
264
265Note that this override doesn't happen until after the program has
266compiled, so any compile-time errors will still show up with the
267non-overridden program name
268
269=head1 CHANGE LOG
270
2713.51 Added $CGI::Carp::TO_BROWSER
272
2731.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
274 not behaving correctly in an eval() context.
275
2761.05 carpout() added and minor corrections by Marc Hedlund
277 <hedlund@best.com> on 11/26/95.
278
2791.06 fatalsToBrowser() no longer aborts for fatal errors within
280 eval() statements.
281
2821.08 set_message() added and carpout() expanded to allow for FileHandle
283 objects.
284
2851.09 set_message() now allows users to pass a code REFERENCE for
286 really custom error messages. croak and carp are now
287 exported by default. Thanks to Gunther Birznieks for the
288 patches.
289
2901.10 Patch from Chris Dean (ctdean@cogit.com) to allow
291 module to run correctly under mod_perl.
292
2931.11 Changed order of &gt; and &lt; escapes.
294
2951.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
296
2971.13 Added cluck() to make the module orthogonal with Carp.
298 More mod_perl related fixes.
299
3001.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi): Added
301 warningsToBrowser(). Replaced <CODE> tags with <PRE> in
302 fatalsToBrowser() output.
303
3041.23 ineval() now checks both $^S and inspects the message for the "eval" pattern
305 (hack alert!) in order to accommodate various combinations of Perl and
306 mod_perl.
307
3081.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support
309 for overriding program name.
310
3111.26 Replaced CORE::GLOBAL::die with the evil $SIG{__DIE__} because the
312 former isn't working in some people's hands. There is no such thing
313 as reliable exception handling in Perl.
314
3151.27 Replaced tell STDOUT with bytes=tell STDOUT.
316
317=head1 AUTHORS
318
319Copyright 1995-2002, Lincoln D. Stein. All rights reserved.
320
321This library is free software; you can redistribute it and/or modify
322it under the same terms as Perl itself.
323
324=head1 SEE ALSO
325
326L<Carp>, L<CGI::Base>, L<CGI::BasePlus>, L<CGI::Request>,
327L<CGI::MiniSvr>, L<CGI::Form>, L<CGI::Response>.
328
329=cut
330
331128µsrequire 5.000;
33221.36ms21.46ms
# spent 1.40ms (1.35+56µs) within CGI::Carp::BEGIN@332 which was called: # once (1.35ms+56µs) by main::BEGIN@9 at line 332
use Exporter;
# spent 1.40ms making 1 call to CGI::Carp::BEGIN@332 # spent 56µs making 1 call to Exporter::import
333#use Carp;
334
# spent 5.37ms (4.92+446µs) within CGI::Carp::BEGIN@334 which was called: # once (4.92ms+446µs) by main::BEGIN@9 at line 337
BEGIN {
3351130µs require Carp;
336120µs *CORE::GLOBAL::die = \&CGI::Carp::die;
337140µs15.37ms}
# spent 5.37ms making 1 call to CGI::Carp::BEGIN@334
338
33923.12ms15.23ms
# spent 5.23ms (3.59+1.63) within CGI::Carp::BEGIN@339 which was called: # once (3.59ms+1.63ms) by main::BEGIN@9 at line 339
use File::Spec;
# spent 5.23ms making 1 call to CGI::Carp::BEGIN@339
340
341113µs@ISA = qw(Exporter);
34212µs@EXPORT = qw(confess croak carp);
34313µs@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_die_handler set_progname cluck ^name= die);
344
34513µs$main::SIG{__WARN__}=\&CGI::Carp::warn;
346
3471600ns$CGI::Carp::VERSION = '3.51';
3481400ns$CGI::Carp::CUSTOM_MSG = undef;
3491200ns$CGI::Carp::DIE_HANDLER = undef;
3501400ns$CGI::Carp::TO_BROWSER = 1;
351
352
353# fancy import routine detects and handles 'errorWrap' specially.
354
# spent 107µs (39+67) within CGI::Carp::import which was called: # once (39µs+67µs) by main::BEGIN@9 at line 9 of view
sub import {
35511µs my $pkg = shift;
3561300ns my(%routines);
3571400ns my(@name);
35817µs if (@name=grep(/^name=/,@_))
359 {
360 my($n) = (split(/=/,$name[0]))[1];
361 set_progname($n);
362 @_=grep(!/^name=/,@_);
363 }
364
36515µs grep($routines{$_}++,@_,@EXPORT);
36611µs $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
3671500ns $WARN++ if $routines{'warningsToBrowser'};
3681700ns my($oldlevel) = $Exporter::ExportLevel;
3691200ns $Exporter::ExportLevel = 1;
37015µs168µs Exporter::import($pkg,keys %routines);
# spent 68µs making 1 call to Exporter::import
3711300ns $Exporter::ExportLevel = $oldlevel;
372113µs $main::SIG{__DIE__} =\&CGI::Carp::die if $routines{'fatalsToBrowser'};
373# $pkg->export('CORE::GLOBAL','die');
374}
375
376# These are the originals
377254µs
# spent 49µs within CGI::Carp::realwarn which was called 2 times, avg 25µs/call: # 2 times (49µs+0s) by CGI::Carp::warn at line 416, avg 25µs/call
sub realwarn { CORE::warn(@_); }
378sub realdie { CORE::die(@_); }
379
380
# spent 65µs (41+24) within CGI::Carp::id which was called 2 times, avg 32µs/call: # 2 times (41µs+24µs) by CGI::Carp::warn at line 411, avg 32µs/call
sub id {
3812700ns my $level = shift;
382215µs my($pack,$file,$line,$sub) = caller($level);
383212µs224µs my($dev,$dirs,$id) = File::Spec->splitpath($file);
# spent 24µs making 2 calls to File::Spec::Unix::splitpath, avg 12µs/call
38429µs return ($file,$line,$id);
385}
386
387
# spent 245µs (231+14) within CGI::Carp::stamp which was called 2 times, avg 122µs/call: # 2 times (231µs+14µs) by CGI::Carp::warn at line 414, avg 122µs/call
sub stamp {
388241µs my $time = scalar(localtime);
3892900ns my $frame = 0;
39022µs my ($id,$pack,$file,$dev,$dirs);
39121µs if (defined($CGI::Carp::PROGNAME)) {
392 $id = $CGI::Carp::PROGNAME;
393 } else {
394226µs do {
395345µs $id = $file;
39634135µs ($pack,$file) = caller($frame++);
397 } until !$file;
398 }
39929µs214µs ($dev,$dirs,$id) = File::Spec->splitpath($id);
# spent 14µs making 2 calls to File::Spec::Unix::splitpath, avg 7µs/call
40029µs return "[$time] $id: ";
401}
402
403sub set_progname {
404 $CGI::Carp::PROGNAME = shift;
405 return $CGI::Carp::PROGNAME;
406}
407
408
409
# spent 405µs (46+359) within CGI::Carp::warn which was called 2 times, avg 203µs/call: # once (29µs+207µs) by Foswiki::Plugin::BEGIN@2.6 at line 90 of /var/www/foswiki11/lib/Foswiki/Plugins/ChartPlugin.pm # once (17µs+152µs) by Foswiki::Plugin::BEGIN@2.19 at line 248 of /var/www/foswiki11/lib/Foswiki/Plugins/JHotDrawPlugin.pm
sub warn {
41021µs my $message = shift;
41126µs265µs my($file,$line,$id) = id(1);
# spent 65µs making 2 calls to CGI::Carp::id, avg 32µs/call
41225µs $message .= " at $file line $line.\n" unless $message=~/\n$/;
4132800ns _warn($message) if $WARN;
41424µs2245µs my $stamp = stamp;
# spent 245µs making 2 calls to CGI::Carp::stamp, avg 122µs/call
41527µs $message=~s/^/$stamp/gm;
416213µs249µs realwarn $message;
# spent 49µs making 2 calls to CGI::Carp::realwarn, avg 25µs/call
417}
418
419sub _warn {
420 my $msg = shift;
421 if ($EMIT_WARNINGS) {
422 # We need to mangle the message a bit to make it a valid HTML
423 # comment. This is done by substituting similar-looking ISO
424 # 8859-1 characters for <, > and -. This is a hack.
425 $msg =~ tr/<>-/\253\273\255/;
426 chomp $msg;
427 print STDOUT "<!-- warning: $msg -->\n";
428 } else {
429 push @WARNINGS, $msg;
430 }
431}
432
433
434# The mod_perl package Apache::Registry loads CGI programs by calling
435# eval. These evals don't count when looking at the stack backtrace.
436sub _longmess {
437 my $message = Carp::longmess();
438 $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s
439 if exists $ENV{MOD_PERL};
440 return $message;
441}
442
443sub ineval {
444 (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
445}
446
447sub die {
448 # if no argument is passed, propagate $@ like
449 # the real die
450 my ($arg,@rest) = @_ ? @_
451 : $@ ? "$@\t...propagated"
452 : "Died"
453 ;
454
455 &$DIE_HANDLER($arg,@rest) if $DIE_HANDLER;
456
457 # the "$arg" is done on purpose!
458 # if called as die( $object, 'string' ),
459 # all is stringified, just like with
460 # the real 'die'
461 $arg = join '' => "$arg", @rest if @rest;
462
463 my($file,$line,$id) = id(1);
464
465 $arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/;
466
467 realdie $arg if ineval();
468 &fatalsToBrowser($arg) if ($WRAP and $CGI::Carp::TO_BROWSER);
469
470 $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
471
472 $arg .= "\n" unless $arg =~ /\n$/;
473
474 realdie $arg;
475}
476
477sub set_message {
478 $CGI::Carp::CUSTOM_MSG = shift;
479 return $CGI::Carp::CUSTOM_MSG;
480}
481
482sub set_die_handler {
483
484 my ($handler) = shift;
485
486 #setting SIG{__DIE__} here is necessary to catch runtime
487 #errors which are not called by literally saying "die",
488 #such as the line "undef->explode();". however, doing this
489 #will interfere with fatalsToBrowser, which also sets
490 #SIG{__DIE__} in the import() function above (or the
491 #import() function above may interfere with this). for
492 #this reason, you should choose to either set the die
493 #handler here, or use fatalsToBrowser, not both.
494 $main::SIG{__DIE__} = $handler;
495
496 $CGI::Carp::DIE_HANDLER = $handler;
497
498 return $CGI::Carp::DIE_HANDLER;
499}
500
501sub confess { CGI::Carp::die Carp::longmess @_; }
502sub croak { CGI::Carp::die Carp::shortmess @_; }
503sub carp { CGI::Carp::warn Carp::shortmess @_; }
504sub cluck { CGI::Carp::warn Carp::longmess @_; }
505
506# We have to be ready to accept a filehandle as a reference
507# or a string.
508sub carpout {
509 my($in) = @_;
510 my($no) = fileno(to_filehandle($in));
511 realdie("Invalid filehandle $in\n") unless defined $no;
512
513 open(SAVEERR, ">&STDERR");
514 open(STDERR, ">&$no") or
515 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
516}
517
518sub warningsToBrowser {
519 $EMIT_WARNINGS = @_ ? shift : 1;
520 _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
521}
522
523# headers
524sub fatalsToBrowser {
525 my $msg = shift;
526
527 $msg = "$msg" if ref $msg;
528
529 $msg=~s/&/&amp;/g;
530 $msg=~s/>/&gt;/g;
531 $msg=~s/</&lt;/g;
532 $msg=~s/"/&quot;/g;
533
534 my($wm) = $ENV{SERVER_ADMIN} ?
535 qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
536 "this site's webmaster";
537 my ($outer_message) = <<END;
538For help, please send mail to $wm, giving this error message
539and the time and date of the error.
540END
541 ;
542 my $mod_perl = exists $ENV{MOD_PERL};
543
544 if ($CUSTOM_MSG) {
545 if (ref($CUSTOM_MSG) eq 'CODE') {
546 print STDOUT "Content-type: text/html\n\n"
547 unless $mod_perl;
548 eval {
549 &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
550 };
551 if ($@) { print STDERR q(error while executing the error handler: $@); }
552
553 return;
554 } else {
555 $outer_message = $CUSTOM_MSG;
556 }
557 }
558
559 my $mess = <<END;
560<h1>Software error:</h1>
561<pre>$msg</pre>
562<p>
563$outer_message
564</p>
565END
566 ;
567
568 if ($mod_perl) {
569 my $r;
570 if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
571 $mod_perl = 2;
572 require Apache2::RequestRec;
573 require Apache2::RequestIO;
574 require Apache2::RequestUtil;
575 require APR::Pool;
576 require ModPerl::Util;
577 require Apache2::Response;
578 $r = Apache2::RequestUtil->request;
579 }
580 else {
581 $r = Apache->request;
582 }
583 # If bytes have already been sent, then
584 # we print the message out directly.
585 # Otherwise we make a custom error
586 # handler to produce the doc for us.
587 if ($r->bytes_sent) {
588 $r->print($mess);
589 $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
590 } else {
591 # MSIE won't display a custom 500 response unless it is >512 bytes!
592 if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
593 $mess = "<!-- " . (' ' x 513) . " -->\n$mess";
594 }
595 $r->custom_response(500,$mess);
596 }
597 } else {
598 my $bytes_written = eval{tell STDOUT};
599 if (defined $bytes_written && $bytes_written > 0) {
600 print STDOUT $mess;
601 }
602 else {
603 print STDOUT "Status: 500\n";
604 print STDOUT "Content-type: text/html\n\n";
605 print STDOUT $mess;
606 }
607 }
608
609 warningsToBrowser(1); # emit warnings before dying
610}
611
612# Cut and paste from CGI.pm so that we don't have the overhead of
613# always loading the entire CGI module.
614sub to_filehandle {
615 my $thingy = shift;
616 return undef unless $thingy;
617 return $thingy if UNIVERSAL::isa($thingy,'GLOB');
618 return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
619 if (!ref($thingy)) {
620 my $caller = 1;
621 while (my $package = caller($caller++)) {
622 my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy";
623 return $tmp if defined(fileno($tmp));
624 }
625 }
626 return undef;
627}
628
629115µs1;