view release on metacpan or  search on metacpan

lib/CGI/Alert.pm  view on Meta::CPAN

	       $msg,
	       "",
	       map { "  * $_" } @warnings);
    }
}


END { check_warnings }
$SIG{TERM} = \&check_warnings;


################
################  FATAL ERRORS.  This gets called on any 'die'.
################
sub _die($) {
    my $msg = shift;

    # Called inside an eval?  Pass it on.  This lets caller do things safely.
    die $msg if $^S or not defined $^S;


    # Not an eval: die for real.

    # First of all: log to stderr (error_log) with script URL and time.
    printf STDERR "[%s - %s]: DIED: %s\n", $ME, scalar localtime, $msg
      unless $DEBUG_SENDMAIL;

    # Next, display an error message to remote (web) user.  Do this before
    # sending out the email: simple print()s are less likely to fail than
    # a complex notify(), and we want to make a good attempt at presenting
    # the remote user with a friendly diagnostic.
    my $browser_text_copy;
    if ($Browser_Text) {
	# If caller has asked us to emit HTTP headers, do so now.
	if ($Emit_HTTP_Headers && !$DEBUG_SENDMAIL) {
	    print  "Status: 500 Server Error\n",
	           "Content-type: text/html; charset=ISO-8859-1\n",
		   "\n";
	}

	my $what = ref($Browser_Text) || '';

	if ($what eq 'CODE') {
	    # $Browser_Text is a subroutine
	    eval { $Browser_Text->($msg, $Emit_HTTP_Headers); };
	    # FIXME FIXME FIXME - now what?
	}
	elsif (!$what) {
	    # $Browser_Text is simple text
	    ($browser_text_copy = $Browser_Text) =~ s/\[MSG\]/$msg/g;
	    $browser_text_copy =~ s/\[MAINTAINER\]/maintainer/ge;

	    print $browser_text_copy		unless $DEBUG_SENDMAIL;
	}
	else {
	    # Not a CODE ref or string
	    push @warnings, "[Yo!  What is \$Browser_Text?  It's '$what', and I only grok 'CODE' or '' (strings)]";
	}
    }
    else {
	# $Browser_Text undefined - I guess we just show nothing to user?
    }


    # Generate a message body for the email we're going to send out
    my @text = ("The script died with:",
		"",
		"  $msg");
    if (@warnings) {
	push @text, "",
	            "In addition, the following warnings were detected:\n",
		    "",
		    map { "  * $_" } @warnings;
	@warnings = ();
    }

    # Send out email.  Inform web user about our emailing efforts.
    notify("FATAL ERRORS", @text);

    printf <<EOP, __PACKAGE__			unless $DEBUG_SENDMAIL;
<hr>
<address>Handled by <samp>%s v$VERSION</samp></address>
</body>
</html>
EOP

    exit 0;
};
$SIG{__DIE__} = \&_die;

# END   compile-time execution
###############################################################################
# BEGIN caller-accessible functions (not yet exported)

#######################
#  emit_http_headers  #  Caller can tell us when to emit 'Status', etc
#######################
sub emit_http_headers($) {
    $Emit_HTTP_Headers = 0 + $_[0];
}

########################
#  extra_html_headers  #  Caller can give us stylesheets, etc
########################
sub extra_html_headers(@) {
    @Extra_HTML_Headers = @_;
}


#########################
#  custom_browser_text  #  Caller can give us a custom text to display
#########################
sub custom_browser_text($) {
    $Browser_Text = shift;
}


# END   caller-accessible functions (not yet exported)
###############################################################################

1;