File Coverage

blib/lib/CGI/Alert.pm
Criterion Covered Total %
statement 32 204 15.6
branch 14 106 13.2
condition 2 30 6.6
subroutine 8 18 44.4
pod 0 7 0.0
total 56 365 15.3


line stmt bran cond sub pod time code
1             # -*- perl -*-
2             #
3             # CGI::Alert.pm - notify a human about errors/warnings in CGI scripts
4             #
5             # $Id: 98 $
6             #
7             package CGI::Alert;
8              
9 1     1   15776 use strict;
  1         2  
  1         44  
10 1     1   6 use warnings;
  1         1  
  1         31  
11 1     1   6 use Carp;
  1         2  
  1         4282  
12              
13             ###############################################################################
14             # BEGIN user-configurable section
15              
16             # If set (by caller, via emit_http_headers), emit HTTP headers
17             our $Emit_HTTP_Headers = 0;
18              
19             # If set (by caller, via emit_html_headers), _and_ CGI.pm is loaded,
20             # emit these extra headers from http_die
21             our @Extra_HTML_Headers;
22              
23             # By default, send notifications to this address. We could try to be
24             # clever about stat'ing the calling script and finding the owner, but
25             # why go to so much effort?
26             our $Maintainer = 'webmaster';
27              
28             # Expressions to filter from the email. We don't want to send passwords,
29             # credit card numbers, or other sensitive info out via email.
30             our @Hide = (qr/(^|[\b_-])passw/i);
31              
32             # Default text shown to the remote (web) user if we die. This tells
33             # the user that something went wrong, but that a responsible party
34             # has been informed.
35             our $Browser_Text = <<'-';
36            

Uh-Oh!

37            

38             The script handling your request died with the following error:
39            

40            
 
41             [MSG]
42            
43            

44             If that indicates a problem you can fix, please do so.
45            

46            

47             Otherwise, don't panic: I have sent a notification to the
48             [MAINTAINER], providing details of the error.
49            

50             -
51              
52             # For stack trace: names of the fields returned by caller(), in order.
53             our @Caller_Fields =
54             qw(
55             package
56             filename
57             line
58             subroutine
59             hasargs
60             wantarray
61             evaltext
62             is_require
63             hints
64             bitmask
65             );
66              
67             #
68             # Package globals, checked at END time.
69             #
70             our @cgi_params; # CGI inputs (GET/POST), set at INIT time
71              
72             my @warnings; # Warnings, both plain...
73             my @warnings_traced; # ...and with stack trace.
74              
75             # For debugging this module, and running tests. Set by t/*.t to a
76             # file path. We write our email to this file, instead of running sendmail.
77             our $DEBUG_SENDMAIL = '';
78              
79             # END user-configurable section
80             ###############################################################################
81              
82             # One exportable (on request) function: http_die
83             our @ISA = qw(Exporter);
84             our @EXPORT_OK = qw(http_die);
85              
86             # Program name of our caller
87             our $ME = $ENV{REQUEST_URI} || $0 || "";
88              
89             # Module version, on one line for MakeMaker
90             our $VERSION = 2.09;
91              
92             ############
93             # import # If called with "use CGI::Alert 'foo@bar'", send mail to foo@bar
94             ############
95             sub import {
96 7     7   4404 my $i = 1;
97 7         29 while ($i < @_) {
98             # Is it a valid exported function? Skip.
99 6 50       6 if (defined &{$_[$i]}) {
  6 50       58  
100 0         0 $i++
101             }
102             elsif ($_[$i] =~ m!^-{0,2}hide=(.+)$!) { # RE to filter out?
103 6         13 my $hide = $1; # Our input
104 6         7 my $re; # ...how we interpret it
105 6 100       19 if ($hide =~ m!^/(.*)/$!) { $re= "qr/$1/" }
  2 100       6  
    100          
106 1         4 elsif ($hide =~ m!^m(.)(.*)\1$!) { $re= "qr/$2/" }
107 1         2 elsif ($hide =~ m!^(qr(.)(.*)\2[ismx]*)$!) { $re= $1 }
108 2         5 else { $re= "qr/$hide/" }
109              
110             # Make sure it can be parsed as a regex.
111 6         298 my $result = eval $re;
112 6 100       20 if ($@) {
113 1         179 carp "Ignoring invalid filter expression '$re': $@";
114             }
115             else {
116 5         6 push @Hide, $result;
117             }
118              
119             # Eliminate it from our import list
120 6         26 splice @_, $i, 1;
121             }
122             else {
123             # Anything else: must be an email address. Point $Maintainer
124             # at it, and remove from our arg list so Exporter doesn't see it.
125 0         0 ($Maintainer) = splice @_, $i, 1;
126             # (don't increment $i, since we've collapsed the array)
127             }
128             }
129              
130              
131             # Anything left over? E.g., 'http_die' ? Pass it along to Exporter
132 7         2008 CGI::Alert->export_to_level(1, @_);
133             }
134              
135             ##################
136             # Final override. This is run after the import, and thus has the last
137             # say on who gets notified.
138             #
139             # We examine our URL. If it's of the form "/~user/something", assume
140             # that "user" is debugging, and would prefer that notifications go just
141             # to him/her.
142             ##################
143             INIT {
144             # Invoked from user URL (~user/...) ? Debugging -- send mail to him/her
145 1 50 50 1   13 if (($ENV{REQUEST_URI} || "") =~ m!/(~|%7e)([^/]+)/!i) {
146             # Does user actually exist?
147 0 0       0 if (getpwnam($2)) {
148 0         0 $Maintainer = $2;
149             }
150             }
151              
152             # If called with CGI parameters, remember them now. Otherwise, our
153             # caller could call Delete_all() (from CGI.pm) or otherwise clear
154             # the params, so we wouldn't have them when our END handler is called.
155 1 50       6 if (exists $INC{'CGI.pm'}) {
156 0         0 eval {
157             # Each element of @cgi_params is an array ref: first element is
158             # the param name, everything else is one or more values.
159 0         0 foreach my $p (CGI::param()) {
160 0         0 push @cgi_params, [ $p, CGI::param($p) ];
161             }
162             };
163 0 0       0 print STDERR __PACKAGE__, ": error in eval: $@\n" if $@;
164             }
165             }
166              
167             ###############################################################################
168             # BEGIN helper functions
169              
170             ###############
171             # _basename # Poor man's implementation, to avoid including File::Basename
172             ###############
173             sub _basename($) {
174 0     0   0 my $f = shift;
175              
176 0 0       0 $f =~ m!/([^/]+)$!
177             and return $1;
178 0         0 return $f;
179             }
180              
181             ##################
182             # _stack_trace # returns pretty stack trace
183             ##################
184             sub _stack_trace() {
185 0     0   0 my @levels;
186              
187             # Get a full callback history, first-is-first (that is, the
188             # main script is first, instead of the usual most-recent-first).
189             # @levels will be a LoH, an array containing hashrefs.
190             #
191             # See perlfunc(1) for details on caller() and the 'DB' hack.
192 0         0 my $i = 0;
193 0         0 my @call_info;
194 0         0 while (do { { package DB; @call_info = caller($i++) } } ) {
  0         0  
  0         0  
195 0         0 unshift @levels, {
196 0         0 (map { $_ => shift @call_info } @Caller_Fields),
197             args => [ @DB::args ],
198             };
199             }
200              
201             # The last few levels of subroutine calls are all inside this
202             # module. Exclude them.
203 0         0 while ($levels[-1]->{filename} =~ m!/Alert\.pm$!) {
204 0         0 pop @levels;
205             }
206              
207             # Last function in the trace is the one that invoked warn/die.
208             # Instead of showing our local sub name, show 'warn' or 'die'.
209 0 0       0 if ($levels[$#levels]->{subroutine} =~ /^CGI::Alert::_(warn|die)$/) {
210 0         0 $levels[$#levels]->{subroutine} = $1;
211             }
212              
213             # Determine the length of the longest filename
214 0         0 my $maxlen = -1;
215 0         0 for my $lev (@levels) {
216 0         0 my $len = length( _basename($lev->{filename}) );
217 0 0       0 $maxlen < $len
218             and $maxlen = $len;
219             }
220              
221 0         0 my $retval = ''; # Returned string.
222 0         0 my $indent = " "; # Function indentation level
223 0         0 my $last_filename = ''; # Last filename seen
224              
225 0         0 for my $l (@levels) {
226 0         0 my $filename = _basename($l->{filename});
227              
228             # Same as last file seen? Don't bother to display it.
229 0 0       0 if ($filename eq $last_filename) {
230 0         0 $filename =~ s|.| |g;
231             }
232             else {
233 0         0 $last_filename = $filename; # remember for next time
234             }
235              
236             # Filename, line number, and subroutine name.
237 0         0 $retval .= sprintf(" %-*s : %4d %s%s(", $maxlen, $filename,
238             $l->{line},
239             $indent, $l->{subroutine});
240              
241             # Function arguments, in parenthesized list.
242 0         0 my $comma = '';
243 0         0 for my $arg (@{$l->{args}}) {
  0         0  
244             # Perform minor adjustments on each arg
245 0 0       0 if (!defined $arg) {
    0          
246 0         0 $arg = 'undef';
247             }
248             elsif (!ref $arg) { # not a ref: must be a string, or a number
249 0         0 $arg =~ s|\n|\\n|g; # escape newlines
250 0 0       0 $arg =~ /\D/ # quote strings
251             and $arg = "\"$arg\"";
252             }
253 0         0 $retval .= "$comma $arg";
254 0         0 $comma = ',';
255             }
256 0         0 $retval .= " )\n";
257              
258             # Keep indenting each subsequent level in the stack trace.
259 0         0 $indent .= " ";
260             }
261              
262 0         0 $retval;
263             }
264              
265              
266             ################
267             # maintainer # returns nicely formatted HREF and address of maintainer
268             ################
269             sub maintainer() {
270 0     0 0 0 my $real_name = "";
271 0         0 my $just_mail = $Maintainer;
272              
273             # Address is of the form "Foo Bar " ?
274 0 0       0 if ($just_mail =~ s/^(.*)<(.*)>(.*)$/$2/) {
275 0         0 $real_name = "$1 $3 ";
276             }
277 0         0 $real_name =~ s|\s+| |g;
278              
279 0         0 return "maintainer, $real_name<$just_mail>";
280             }
281              
282             # END helper functions
283             ###############################################################################
284             # BEGIN main notification function
285              
286             ############
287             # notify # Gets called on END, to send email to maintainer
288             ############
289             sub notify($@) {
290 0     0 0 0 my $subject = shift;
291              
292 0         0 eval {
293 0         0 my %env = %ENV;
294 0         0 local %ENV;
295 0         0 local $ENV{PATH} = "/usr/sbin:/usr/lib"; # Where sendmail lives
296              
297             # MIME part divider
298 0         0 my $b = sprintf("==XxX%05d", $$);
299              
300 0 0       0 my $sendmail = ($DEBUG_SENDMAIL
301             ? "> $DEBUG_SENDMAIL"
302             : '| sendmail -oi -t');
303              
304             open(SENDMAIL, $sendmail)
305 0 0       0 or do {
306 0         0 print STDERR "Could not fork sendmail: $!\n";
307 0         0 exit 1;
308             };
309              
310 0         0 my $http_host_full = 'localhost';
311 0         0 my $at_http_host = '';
312 0 0 0     0 if (($env{HTTP_HOST}||'') =~ m!^(([\w\d.-]+)(:\d+)?)$!) {
313             # FIXME: for email host, remove the ':80'.
314 0         0 $http_host_full = $1;
315 0         0 $at_http_host = '@' . $2;
316             }
317              
318 0   0     0 my $request_uri = $env{REQUEST_URI} || "/unknown-url";
319              
320 0         0 my $package = __PACKAGE__; # Can't string-interpolate __PACKAGE__
321              
322             # Do we know the remote user? Make it easy for maintainer to reply.
323 0 0 0     0 exists $env{REMOTE_USER} && $env{REMOTE_USER}
324             and print SENDMAIL "Reply-To: $env{REMOTE_USER}\n";
325              
326             # Even though the subject distinguishes between errors and warnings,
327             # it can be helpful to scan based on 'From' line as well. Plus,
328             # Ed's mail-announce speech synthesizer will then differentiate them
329 0 0       0 my $from = "CGI " . ($subject =~ /warn/i
330             ? "Warnings"
331             : "Errors");
332              
333             # Include CGI script name and version (if known) in X-mailer
334 0         0 my $cgi_script = _basename($0);
335 0 0       0 $cgi_script .= " v$main::VERSION" if defined $main::VERSION;
336              
337 0         0 print SENDMAIL <<"-";
338             From: $from
339             To: $Maintainer
340             Subject: $subject in http://$http_host_full$request_uri
341             X-mailer: $cgi_script, via $package v$VERSION
342             Precedence: bulk
343             MIME-Version: 1.0
344             Content-Type: multipart/mixed;
345             boundary="$b"
346              
347             This is a MIME-Encapsulated message. You can read it as plain text
348             if you insist.
349              
350             --$b
351             Content-Type: text/plain; charset=us-ascii
352              
353             -
354              
355             # Message body: start with whatever the user told us to say.
356 0         0 print SENDMAIL $_, "\n" foreach @_;
357 0         0 print SENDMAIL "\n";
358              
359             # Display remote user/host info
360 0 0 0     0 if (exists $env{REMOTE_USER} || exists $env{REMOTE_ADDR}) {
361 0         0 print SENDMAIL "Remote user is ";
362              
363 0 0       0 if (exists $env{REMOTE_USER}) {
364 0   0     0 print SENDMAIL $env{REMOTE_USER} || "";
365 0 0       0 print SENDMAIL " @ " if exists $env{REMOTE_ADDR};
366             }
367 0 0       0 if (exists $env{REMOTE_ADDR}) {
368             # Find out remote host name. Bracket inside an EVAL, so we
369             # don't slow down normal execution by doing "use Socket".
370 0         0 my @a = eval 'use Socket qw(AF_INET inet_aton);
371             gethostbyaddr(inet_aton($env{REMOTE_ADDR}), AF_INET);';
372 0 0       0 if ($@) {
373 0         0 print SENDMAIL $env{REMOTE_ADDR};
374             } else {
375 0   0     0 printf SENDMAIL "%s [%s]", $a[0]||"",$env{REMOTE_ADDR};
376             }
377             }
378 0         0 print SENDMAIL "\n";
379             }
380              
381             # Display our name and version
382 0         0 print SENDMAIL "\n",
383             "This message brought to you by $package v$VERSION\n";
384              
385              
386             # If this was a "die", add a stack trace
387 0 0       0 $subject =~ /FATAL/ and eval {
388 0         0 local $SIG{__DIE__};
389 0         0 print SENDMAIL <<"-", _stack_trace;
390              
391             --$b
392             Content-Type: text/plain; name="stack-trace"
393             Content-Description: Stack Trace
394              
395             -
396             };
397              
398             #
399             # If CGI.pm is loaded, and we had CGI params, make a new MIME section
400             # showing each param and its value(s). This is all wrapped in an
401             # eval block, since we don't want to call CGI::param() if CGI.pm
402             # isn't loaded (plus, we don't really care about errors).
403             #
404 0 0       0 @cgi_params and eval {
405 0         0 local $SIG{__DIE__};
406              
407             # MIME boundary. Describe the new section, and show GET or POST
408 0   0     0 my $method = $env{REQUEST_METHOD} || "no REQUEST_METHOD";
409 0         0 print SENDMAIL <<"-";
410              
411             --$b
412             Content-Type: text/plain; name="CGI-Params"
413             Content-Description: CGI Parameters ($method)
414              
415             -
416              
417             # Find length of longest param...
418 0         0 my $maxlen = -1;
419 0         0 foreach my $set (@cgi_params) {
420 0 0       0 $maxlen < length($set->[0])
421             and $maxlen = length($set->[0]);
422             }
423             # ...then display each, one per line
424 0         0 foreach my $set (@cgi_params) {
425 0         0 my ($p, @v) = @$set;
426              
427             # For security purposes, never send out passwords, credit cards
428 0 0       0 grep { $p =~ /$_/ } @Hide
  0         0  
429             and @v = ('[...]');
430              
431 0 0       0 printf SENDMAIL " %-*s = %s\n", $maxlen, $p,
432             (defined($v[0]) ? $v[0] : '');
433             # If this param is an array of more than one value, show all.
434 0         0 for (my $i=1; $i < @v; $i++) {
435 0         0 printf SENDMAIL " %-*s + %s\n", $maxlen, "", $v[$i];
436             }
437             }
438             };
439              
440             #
441             # Another MIME section: stack traces (on warnings), if any
442             #
443 0 0       0 if (@warnings_traced) {
444 0         0 print SENDMAIL <<"-";
445              
446             --$b
447             Content-Type: text/plain; name="warnings"
448             Content-Description: Warnings, with Stack Traces
449              
450             -
451              
452 0         0 print SENDMAIL " * $_\n\n" for @warnings_traced;
453 0         0 print SENDMAIL "\n";
454             }
455              
456             #
457             # New MIME Section: environment
458             #
459 0         0 print SENDMAIL <<"-";
460              
461             --$b
462             Content-Type: text/plain; name="Environment"
463             Content-Description: Environment
464              
465             -
466 0         0 foreach my $v (sort keys %env) { # FIXME: do in order of importance?
467 0   0     0 printf SENDMAIL "%-15s = %s\n", $v, $env{$v}||'[undef]';
468             }
469              
470             #
471             # Another MIME Section: included headers
472             #
473 0         0 print SENDMAIL <<"-";
474              
475             --$b
476             Content-Type: text/plain; name="%INC"
477             Content-Description: Included Headers
478              
479             -
480 0         0 foreach my $v (sort keys %INC) {
481 0   0     0 printf SENDMAIL "%-25s = %s\n", $v, $INC{$v}||'[undef]';
482             }
483 0         0 print SENDMAIL "\n";
484              
485             # Final MIME separator, indicates the end
486 0         0 print SENDMAIL "--$b--\n";
487              
488              
489 0 0       0 close SENDMAIL
490             or die "Error running sendmail; status = $?\n";
491             };
492              
493 0         0 return $@;
494             }
495              
496             # END main notification function
497             ###############################################################################
498             # BEGIN auxiliary function for our caller to die _before_ emitting headers
499              
500             ##############
501             # http_die # Called if we see an error _before_ emitting HTTP headers.
502             ##############
503             sub http_die($@) {
504 0     0 0 0 my $status = shift; # Something like "400 Bad Request"
505             # Or maybe it's '--no-mail' ? If so, $status is the next one
506 0 0       0 if ($status =~ /^--?no-?(mail|alert)$/) {
507             $SIG{__WARN__} = sub {
508 0     0   0 printf STDERR "[%s - %s]: DIED: %s\n", $ME, scalar localtime, @_;
509 0         0 };
510 0         0 $status = shift;
511             }
512              
513             # No reason for user to see the numeric code, it's just confusing.
514 0         0 (my $friendly_status = $status) =~ s/^\d+\s*//;
515              
516             # This would best be done by CGI.pm, but we don't want the overhead.
517 0         0 my $start = <<"-";
518             Status: $status
519             Content-Type: text/html; charset=ISO-8859-1
520              
521            
522            
523             PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
524             "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
525            
526            
527             $status
528            
529             -
530              
531 0 0       0 if ($INC{'CGI.pm'}) {
532 0         0 $start = CGI::header(-status => $status)
533             . CGI::start_html(-title => $status, @Extra_HTML_Headers);
534             }
535              
536 0         0 print <<"-";
537             $start
538              
539            

$friendly_status

540            

541             @_
542            

543            
544             -
545              
546             # Emit a warning. This goes to the logfile, but should also trigger
547             # an email to the code maintainer.
548 0         0 warn "Script error: $status\n"
549             . ": " . join("\n: ", @_);
550              
551 0         0 exit 0;
552             }
553              
554              
555             # END auxiliary function for our caller to die _before_ emitting headers
556             ###############################################################################
557             # BEGIN compile-time execution
558             #
559             # This is evaluated the moment our caller does 'use CGI::Alert'.
560             #
561              
562             #
563             # Execute this on each warning
564             #
565             sub _warn {
566 0     0   0 my $w = shift;
567              
568             # Things can get quickly out of hand. We don't want to send an
569             # unreadably long email... so just include the first 10 (FIXME)
570             # warnings. Anything more, and just include a count.
571 0 0       0 if (@warnings < 10) {
572 0         0 push @warnings, $w;
573 0         0 push @warnings_traced, $w . _stack_trace;
574             }
575             else {
576 0 0       0 push @warnings, '(....0 more...)' if @warnings == 10;
577 0         0 $warnings[-1] =~ s/(\d+)/$1 + 1/e;
  0         0  
578             }
579              
580             # Always send the warning to STDERR (usually goes to error_log).
581             # Include the base URL and the time.
582 0 0       0 printf STDERR "[%s - %s] %s\n", $ME, scalar(localtime), $w
583             unless $DEBUG_SENDMAIL;
584             };
585             $SIG{__WARN__} = \&_warn;
586              
587             # (helper function for END and signal handlers
588             sub check_warnings(;$) {
589 1 50   1 0 7 if (@warnings) {
590 0         0 my $msg = "The following warnings were detected:";
591              
592             # Called with arguments? Must be a signal.
593 0 0       0 if (@_) { $msg = "Script was aborted by SIG$_[0]! $msg" }
  0 0       0  
594             # Bad exit status? Indicate so.
595 0         0 elsif ($?) { $msg = "Script terminated with status $?! $msg" }
596              
597 0         0 notify("Warnings",
598             $msg,
599             "",
600 0         0 map { " * $_" } @warnings);
601             }
602             }
603              
604              
605 1     1   733 END { check_warnings }
606             $SIG{TERM} = \&check_warnings;
607              
608              
609             ################
610             ################ FATAL ERRORS. This gets called on any 'die'.
611             ################
612             sub _die($) {
613 2     2   8 my $msg = shift;
614              
615             # Called inside an eval? Pass it on. This lets caller do things safely.
616 2 50 33     30 die $msg if $^S or not defined $^S;
617              
618              
619             # Not an eval: die for real.
620              
621             # First of all: log to stderr (error_log) with script URL and time.
622 0 0         printf STDERR "[%s - %s]: DIED: %s\n", $ME, scalar localtime, $msg
623             unless $DEBUG_SENDMAIL;
624              
625             # Next, display an error message to remote (web) user. Do this before
626             # sending out the email: simple print()s are less likely to fail than
627             # a complex notify(), and we want to make a good attempt at presenting
628             # the remote user with a friendly diagnostic.
629 0           my $browser_text_copy;
630 0 0         if ($Browser_Text) {
631             # If caller has asked us to emit HTTP headers, do so now.
632 0 0 0       if ($Emit_HTTP_Headers && !$DEBUG_SENDMAIL) {
633 0           print "Status: 500 Server Error\n",
634             "Content-type: text/html; charset=ISO-8859-1\n",
635             "\n";
636             }
637              
638 0   0       my $what = ref($Browser_Text) || '';
639              
640 0 0         if ($what eq 'CODE') {
    0          
641             # $Browser_Text is a subroutine
642 0           eval { $Browser_Text->($msg, $Emit_HTTP_Headers); };
  0            
643             # FIXME FIXME FIXME - now what?
644             }
645             elsif (!$what) {
646             # $Browser_Text is simple text
647 0           ($browser_text_copy = $Browser_Text) =~ s/\[MSG\]/$msg/g;
648 0           $browser_text_copy =~ s/\[MAINTAINER\]/maintainer/ge;
  0            
649              
650 0 0         print $browser_text_copy unless $DEBUG_SENDMAIL;
651             }
652             else {
653             # Not a CODE ref or string
654 0           push @warnings, "[Yo! What is \$Browser_Text? It's '$what', and I only grok 'CODE' or '' (strings)]";
655             }
656             }
657             else {
658             # $Browser_Text undefined - I guess we just show nothing to user?
659             }
660              
661              
662             # Generate a message body for the email we're going to send out
663 0           my @text = ("The script died with:",
664             "",
665             " $msg");
666 0 0         if (@warnings) {
667 0           push @text, "",
668             "In addition, the following warnings were detected:\n",
669             "",
670 0           map { " * $_" } @warnings;
671 0           @warnings = ();
672             }
673              
674             # Send out email. Inform web user about our emailing efforts.
675 0           notify("FATAL ERRORS", @text);
676              
677 0 0         printf <
678            
679            
Handled by %s v$VERSION
680            
681            
682             EOP
683              
684 0           exit 0;
685             };
686             $SIG{__DIE__} = \&_die;
687              
688             # END compile-time execution
689             ###############################################################################
690             # BEGIN caller-accessible functions (not yet exported)
691              
692             #######################
693             # emit_http_headers # Caller can tell us when to emit 'Status', etc
694             #######################
695             sub emit_http_headers($) {
696 0     0 0   $Emit_HTTP_Headers = 0 + $_[0];
697             }
698              
699             ########################
700             # extra_html_headers # Caller can give us stylesheets, etc
701             ########################
702             sub extra_html_headers(@) {
703 0     0 0   @Extra_HTML_Headers = @_;
704             }
705              
706              
707             #########################
708             # custom_browser_text # Caller can give us a custom text to display
709             #########################
710             sub custom_browser_text($) {
711 0     0 0   $Browser_Text = shift;
712             }
713              
714              
715             # END caller-accessible functions (not yet exported)
716             ###############################################################################
717              
718             1;
719              
720             __END__