CGI-GuruMeditation
view release on metacpan or search on metacpan
GuruMeditation.pm view on Meta::CPAN
# determine run-time error message
$msg = &escape_html($msg);
$msg =~ s;^(.+)(\s+at\s+)(.+?)(\s+line\s+)(.+?)(\.?\r?\n?)$;
"<span class=\"hi\">$1</span>$2<span class=\"hi\">$3</span>$4<span class=\"hi\">$5</span>$6"
;se;
$debug = qq{
<p/>
<span class="debug">Perl Run-Time Error:</span><br/>
<pre class="debug">$msg</pre>
<p/>
<span class="debug">Perl Run-Time Stack Backtrace:</span><br/>
<pre class="debug">$backtrace</pre>
<p/>
<span class="debug">Perl Source-Code Excerpt:</span><br/>
<pre class="debug">$excerpt</pre>
<p/>
<span class="debug">Perl Run-Time Environment:</span><br/>
<pre class="debug">$env</pre>
};
}
# generate HTML page
my $html = qq{
<html>
<head>
<style type="text/css">
HTML {
width: 100%;
height: auto;
}
BODY {
background: #cccccc;
margin: 0 0 0 0;
padding: 0 0 0 0;
}
DIV.canvas {
background: #000000;
border: 20px solid #000000;
background: #000000;
color: #ff0000;
font-family: monospace;
}
DIV.error1 {
border-top: 6px solid #ff0000;
border-left: 6px solid #ff0000;
border-right: 6px solid #ff0000;
border-bottom: 6px solid #ff0000;
padding: 10px 10px 10px 10px;
}
DIV.error2 {
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();
( run in 0.952 second using v1.01-cache-2.11-cpan-d01c6094234 )