File Coverage

blib/lib/ClearPress/view/error.pm

Criterion	Covered	Total	%
statement	51	56	91.0
branch	5	10	50.0
condition	7	15	46.6
subroutine	10	10	100.0
pod	3	3	100.0
total	76	94	80.8

# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
#########
# Author: rmp
#
package ClearPress::view::error;
use strict;
use warnings;
use base qw(ClearPress::view Class::Accessor);
use English qw(-no_match_vars);
use Template;
use Carp;
use Readonly;

__PACKAGE__->mk_accessors(qw(errstr));

our $VERSION = q[477.1.4];

Readonly::Scalar our $CODEMAP => {
                300 => q[Multiple Choices],
                301 => q[Moved Permanently],
                302 => q[Found],
                303 => q[See Other],
                304 => q[Not Modified],
                306 => q[Switch Proxy],
                307 => q[Temporary Redirect],
                308 => q[Resume Incomplete],
                400 => q[Bad Request],
                401 => q[Unauthorised],
                402 => q[Payment Required],
                403 => q[Forbidden],
                404 => q[Not Found],
                405 => q[Method Not Allowed],
                406 => q[Not Acceptable],
                407 => q[Proxy Authentication Required],
                408 => q[Request Timeout],
                409 => q[Conflict],
                410 => q[Gone],
                411 => q[Length Required],
                412 => q[Precondition Failed],
                413 => q[Request Entity Too Large],
                414 => q[Request-URI Too Long],
                415 => q[Unsupported Media Type],
                416 => q[Requested Range Not Satisfiable],
                417 => q[Expectation Failed],
                500 => q[Internal Server Error],
                501 => q[Not Implemented],
                502 => q[Bad Gateway],
                503 => q[Service Unavailable],
                504 => q[Gateway Timeout],
                505 => q[HTTP Version Not Supported],
                511 => q[Network Authentication Required],
               };

sub safe_errors {
  return 1;
}

sub init {
  my $self = shift;
  my $util = $self->util;
  my $cgi  = $util->cgi;

  $self->{errstr} = $cgi->unescape($cgi->param('errstr') || q[]) || q[];

  return $self->SUPER::init();
}

sub render {
  my $self   = shift;
  my $util   = $self->util;
  my $cgi    = $util->cgi;
  my $aspect = $self->aspect() || q[];
  my $errstr = $self->errstr;
  my $pi     = $ENV{PATH_INFO} || q[];
  my ($code) = $pi =~ m{(\d+)}smix; # Requires Apache ErrorDocument //. mod_perl can use $ENV{REDIRECT_STATUS} but doesn't work under cgi

  $errstr ||= $CODEMAP->{$code||q[]};
  $errstr ||= q[];

  if(Template->error()) {
    $errstr .= q(Template Error: ) . Template->error();
  }

  if($self->safe_errors) {
    print {*STDERR} "Serving error: $errstr\n" or croak $ERRNO;
    $errstr =~ s/[ ]at[ ]\S+[ ]line[ ][[:digit:]]+//smxg;
    $errstr =~ s/\s+[.]?$//smx;
  }

  #########
  # initialise tt_filters by resetting tt
  #
  delete $util->{tt};
  my $tt      = $self->tt;
  my $content = q[];
  my $decor   = $self->decorator;

#  carp qq[$self view::error: handling error response];
  if($aspect =~ /(?:ajax|xml|rss|atom)$/smx) {
    my $escaped = $self->tt_filters->{xml_entity}->($errstr);
    $content = qq[\nError: $escaped];

  } elsif($aspect =~ /json$/smx) {
    my $escaped = $self->tt_filters->{js_string}->($errstr);
    $content = qq[{"error":"Error: $escaped"}];

  } else {
    my $escaped = $self->tt_filters->{xml_entity}->($errstr);
    my $message = $CODEMAP->{$code||q[]} || q[An Error Occurred];
    $content = sprintf <<'EOT', $message, $self->actions(), $escaped;

  %s
  %s
  Error: %s

EOT
  }

  #########
  # render should return content for non-streamed responses
  #
  return $content;
}

1;

__END__