XHTML results from the CPAN

XHTML
CGI-Alert
view release on metacpan or search on metacpan
Content-Description: Environment

-
	foreach my $v (sort keys %env) {  # FIXME: do in order of importance?
	    printf SENDMAIL "%-15s = %s\n", $v, $env{$v}||'[undef]';
	}

	#
	# Another MIME Section: included headers
	#
	print  SENDMAIL <<"-";

--$b
Content-Type: text/plain; name="%INC"
Content-Description: Included Headers

-
	foreach my $v (sort keys %INC) {
	    printf SENDMAIL "%-25s = %s\n", $v, $INC{$v}||'[undef]';
	}
	print  SENDMAIL "\n";

	# Final MIME separator, indicates the end
	print  SENDMAIL "--$b--\n";


	close SENDMAIL
	  or die "Error running sendmail; status = $?\n";
    };

    return $@;
}

# END   main notification function
###############################################################################
# BEGIN auxiliary function for our caller to die _before_ emitting headers

##############
#  http_die  #  Called if we see an error _before_ emitting HTTP headers.
##############
sub http_die($@) {
    my $status   = shift;		# Something like "400 Bad Request"
    # Or maybe it's '--no-mail' ?  If so, $status is the next one
    if ($status =~ /^--?no-?(mail|alert)$/) {
	$SIG{__WARN__} = sub {
	    printf STDERR "[%s - %s]: DIED: %s\n", $ME, scalar localtime, @_;
	};
	$status = shift;
    }

    # No reason for user to see the numeric code, it's just confusing.
    (my $friendly_status = $status) =~ s/^\d+\s*//;

    # This would best be done by CGI.pm, but we don't want the overhead.
    my $start = <<"-";
Status: $status
Content-Type: text/html; charset=ISO-8859-1

<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
         "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
<head>
 <title>$status</title>
</head>
-

    if ($INC{'CGI.pm'}) {
	$start = CGI::header(-status => $status)
	       . CGI::start_html(-title => $status, @Extra_HTML_Headers);
    }

    print <<"-";
$start

<h1>$friendly_status</h1>
<p />
@_
<p />
<hr />
-

    # Emit a warning.  This goes to the logfile, but should also trigger
    # an email to the code maintainer.
    warn "Script error: $status\n"
       . ": " . join("\n: ", @_);

    exit 0;
}


# END   auxiliary function for our caller to die _before_ emitting headers
###############################################################################
# BEGIN compile-time execution
#
# This is evaluated the moment our caller does 'use CGI::Alert'.
#

#
# Execute this on each warning
#
sub _warn {
    my $w = shift;

    # Things can get quickly out of hand.  We don't want to send an
    # unreadably long email... so just include the first 10 (FIXME)
    # warnings.  Anything more, and just include a count.
    if (@warnings < 10) {
	push @warnings, $w;
	push @warnings_traced, $w . _stack_trace;
    }
    else {
	push @warnings, '(....0 more...)'		if @warnings == 10;
	$warnings[-1] =~ s/(\d+)/$1 + 1/e;
    }

    # Always send the warning to STDERR (usually goes to error_log).
    # Include the base URL and the time.
    printf STDERR "[%s - %s] %s\n", $ME, scalar(localtime), $w
      unless $DEBUG_SENDMAIL;
( run in 0.922 second using v1.01-cache-2.11-cpan-39bf76dae61 )