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


line stmt bran cond sub pod time code
1             # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
2             # vim:ts=8:sw=2:et:sta:sts=2
3             #########
4             # Author: rmp
5             #
6             package ClearPress::view::error;
7 4     4   856 use strict;
  4         9  
  4         134  
8 4     4   24 use warnings;
  4         9  
  4         118  
9 4     4   22 use base qw(ClearPress::view Class::Accessor);
  4         8  
  4         611  
10 4     4   32 use English qw(-no_match_vars);
  4         11  
  4         38  
11 4     4   1710 use Template;
  4         8  
  4         116  
12 4     4   22 use Carp;
  4         11  
  4         265  
13 4     4   26 use Readonly;
  4         9  
  4         2998  
14              
15             __PACKAGE__->mk_accessors(qw(errstr));
16              
17             our $VERSION = q[477.1.4];
18              
19             Readonly::Scalar our $CODEMAP => {
20             300 => q[Multiple Choices],
21             301 => q[Moved Permanently],
22             302 => q[Found],
23             303 => q[See Other],
24             304 => q[Not Modified],
25             306 => q[Switch Proxy],
26             307 => q[Temporary Redirect],
27             308 => q[Resume Incomplete],
28             400 => q[Bad Request],
29             401 => q[Unauthorised],
30             402 => q[Payment Required],
31             403 => q[Forbidden],
32             404 => q[Not Found],
33             405 => q[Method Not Allowed],
34             406 => q[Not Acceptable],
35             407 => q[Proxy Authentication Required],
36             408 => q[Request Timeout],
37             409 => q[Conflict],
38             410 => q[Gone],
39             411 => q[Length Required],
40             412 => q[Precondition Failed],
41             413 => q[Request Entity Too Large],
42             414 => q[Request-URI Too Long],
43             415 => q[Unsupported Media Type],
44             416 => q[Requested Range Not Satisfiable],
45             417 => q[Expectation Failed],
46             500 => q[Internal Server Error],
47             501 => q[Not Implemented],
48             502 => q[Bad Gateway],
49             503 => q[Service Unavailable],
50             504 => q[Gateway Timeout],
51             505 => q[HTTP Version Not Supported],
52             511 => q[Network Authentication Required],
53             };
54              
55             sub safe_errors {
56 1     1 1 4 return 1;
57             }
58              
59             sub init {
60 1     1 1 5 my $self = shift;
61 1         7 my $util = $self->util;
62 1         19 my $cgi = $util->cgi;
63              
64 1   50     14 $self->{errstr} = $cgi->unescape($cgi->param('errstr') || q[]) || q[];
65              
66 1         70 return $self->SUPER::init();
67             }
68              
69             sub render {
70 1     1 1 3 my $self = shift;
71 1         4 my $util = $self->util;
72 1         11 my $cgi = $util->cgi;
73 1   50     4 my $aspect = $self->aspect() || q[];
74 1         13 my $errstr = $self->errstr;
75 1   50     13 my $pi = $ENV{PATH_INFO} || q[];
76 1         8 my ($code) = $pi =~ m{(\d+)}smix; # Requires Apache ErrorDocument //. mod_perl can use $ENV{REDIRECT_STATUS} but doesn't work under cgi
77              
78 1   50     16 $errstr ||= $CODEMAP->{$code||q[]};
      33        
79 1   50     20 $errstr ||= q[];
80              
81 1 50       15 if(Template->error()) {
82 0         0 $errstr .= q(Template Error: ) . Template->error();
83             }
84              
85 1 50       22 if($self->safe_errors) {
86 1 50       2 print {*STDERR} "Serving error: $errstr\n" or croak $ERRNO;
  1         38  
87 1         7 $errstr =~ s/[ ]at[ ]\S+[ ]line[ ][[:digit:]]+//smxg;
88 1         4 $errstr =~ s/\s+[.]?$//smx;
89             }
90              
91             #########
92             # initialise tt_filters by resetting tt
93             #
94 1         28 delete $util->{tt};
95 1         93 my $tt = $self->tt;
96 1         3 my $content = q[];
97 1         8 my $decor = $self->decorator;
98              
99             # carp qq[$self view::error: handling error response];
100 1 50       18 if($aspect =~ /(?:ajax|xml|rss|atom)$/smx) {
    50          
101 0         0 my $escaped = $self->tt_filters->{xml_entity}->($errstr);
102 0         0 $content = qq[\nError: $escaped];
103              
104             } elsif($aspect =~ /json$/smx) {
105 0         0 my $escaped = $self->tt_filters->{js_string}->($errstr);
106 0         0 $content = qq[{"error":"Error: $escaped"}];
107              
108             } else {
109 1         5 my $escaped = $self->tt_filters->{xml_entity}->($errstr);
110 1   50     24 my $message = $CODEMAP->{$code||q[]} || q[An Error Occurred];
111 1         17 $content = sprintf <<'EOT', $message, $self->actions(), $escaped;
112            
113            

%s

114             %s
115            

Error: %s

116            
117             EOT
118             }
119              
120             #########
121             # render should return content for non-streamed responses
122             #
123 1         6 return $content;
124             }
125              
126             1;
127              
128             __END__