CGI-GuruMeditation
view release on metacpan or search on metacpan
GuruMeditation.pm view on Meta::CPAN
border-top: 6px solid #000000;
border-left: 6px solid #000000;
border-right: 6px solid #000000;
border-bottom: 6px solid #000000;
padding: 10px 10px 10px 10px;
}
DIV.title {
font-size: 150%;
font-weight: bold;
text-align: center;
width: 100%;
}
DIV.sig {
color: #ff0000;
text-align: center;
}
DIV.sig A {
color: #ff0000;
text-decoration: none;
}
DIV.sig A:link {
color: #ff0000;
text-decoration: none;
}
DIV.sig A:visited {
color: #ff0000;
text-decoration: none;
}
SPAN.debug {
font-size: 120%;
font-weight: bold;
color: #f0f0f0;
}
PRE.debug {
color: #f0f0f0;
padding: 0px 0px 0px 20px;
}
PRE.debug SPAN.hi {
color: #ffcc99;
}
PRE.debug SPAN.marker {
border: 1px solid #ff0000;
padding: 1px 2px 1px 2px;
color: #ffcc99;
}
PRE.debug SPAN.escaped {
color: #000000;
background-color: #cc9966;
padding: 0px 1px 0px 1px;
font-weight: bold;
}
</style>
<script language="JavaScript">
var count = 0;
function blinker() {
var obj = document.getElementById('error');
if (count++ % 2 == 0)
obj.className = 'error1';
else
obj.className = 'error2';
setTimeout('blinker()', 680);
}
</script>
<title>Guru Meditation</title>
</head>
<body onLoad="setTimeout('blinker()', 1);">
<div class="canvas">
<div id="error" class="error1">
<div class="title">$title</div>
</div>
<p/>
<div class="sig">$sig</div>
$debug
</div>
</body>
</html>
};
# post-process HTML page
my $n = 99; $html =~ s/^(\s+)/$n = min($n, length($1)), $1/mge;
$html =~ s/^\s{$n}//mg; # get rid of common indentation
$html =~ s/^\s+//s; # get rid of leading newline
# brain-dead MSIE won't display a custom 500 response unless it is >512 bytes!
if ($ENV{'HTTP_USER_AGENT'} =~ /MSIE/) {
$html .= "<!-- " . ('X' x 512) . " -->\n";
}
# generate HTTP response
my $http = "";
if ($mod_perl) {
my $r;
if ($mod_perl >= 2) {
require Apache2::RequestRec;
require Apache2::RequestIO;
require Apache2::RequestUtil;
require APR::Pool;
require ModPerl::Util;
require Apache2::Response;
$r = Apache2::RequestUtil->request;
}
else {
$r = Apache->request;
}
if (not $r->bytes_sent) {
$r->status(500);
$r->header_out("Expires", "0");
$r->no_cache(1);
$r->content_type("text/html; charset=ISO-8859-1");
$r->send_http_header();
}
$r->print($html);
if ($mod_perl >= 2) {
ModPerl::Util::exit(0);
}
else {
$r->exit();
}
}
else {
$|++;
my $bytes_sent = eval { tell STDOUT };
if (not (defined($bytes_sent) && $bytes_sent > 0)) {
print STDOUT
"Status: 500 Internal Server Error\n" .
"Expires: 0\n" .
( run in 1.129 second using v1.01-cache-2.11-cpan-7f9471e7e0a )