ASP4

 view release on metacpan or  search on metacpan

lib/ASP4/ErrorHandler.pm  view on Meta::CPAN


package ASP4::ErrorHandler;

use strict;
use warnings 'all';
use base 'ASP4::HTTPHandler';
use vars __PACKAGE__->VARS;
use MIME::Base64;
use Data::Dumper;


sub run
{
  my ($s, $context) = @_;
  
  my $error = $Stash->{error};
  $s->print_error( $error );
  $s->send_error( $error );
}# end run()


sub print_error
{
  my ($s, $error) = @_;
  
  $Response->ContentType('text/html');

  if( $ENV{HTTP_HOST} eq 'localhost' )
  {
    $Response->Write( Dumper(\%$error) );
  }
  else
  {
    $Response->Write( $s->error_html( $error ) );
  }# end if()
  
  $Response->Flush;
}# end print_error()


sub send_error
{
  my ($s, $error) = @_;
  
  $Server->Mail(
    To                          => $Config->errors->mail_errors_to,
    From                        => $Config->errors->mail_errors_from,
    Subject                     => "ASP4: Error in @{[ $ENV{HTTP_HOST} ]}@{[ $ENV{REQUEST_URI} ]}",
    'content-type'              => 'text/html',
    'content-transfer-encoding' => 'base64',
    Message                     => encode_base64( $s->error_html($error) ),
    smtp                        => $Config->errors->smtp_server,
  );
}# end send_error()


sub error_html
{
  my ($s, $error) = @_;
  
  my $msg = <<"ERROR";
<!DOCTYPE html>
<html>
<head><title>500 Server Error</title>
<meta charset="utf-8" />
<style type="text/css">
HTML,BODY {
  background-color: #FFFFFF;
}
HTML,BODY,P,DIV {
  font-family: Arial, Helvetica, Sans-Serif;
}
HTML,BODY,P,PRE,DIV {
  font-size: 12px;
}
H1 {
  font-size: 50px;
  font-weight: bold;
}
PRE {
  padding-right: 10px;
  line-height: 16px;
}
.code {
  margin-top: 20px;
  margin-left: 15px;
  width: 95%;
  padding: 10px;
  overflow: auto;
  border: solid 1px #808080;
  background-color: #FFFFCC;
}
.clear {
  clear: both;
}
.label {
  text-align: right;
  padding-right: 5px;
  float: left;
  width: 80px;
  font-weight: bold;
}
.info {
  float: left;
  color: #CC0000;
}
</style>
<body>
<h1>500 Server Error</h1>
<h2>@{[ $error->message ]}</h2>



( run in 0.751 second using v1.01-cache-2.11-cpan-3d66aa2751a )