File Coverage

blib/lib/Kossy/Exception.pm
Criterion Covered Total %
statement 39 39 100.0
branch 8 8 100.0
condition 7 8 87.5
subroutine 8 8 100.0
pod 0 3 0.0
total 62 66 93.9


line stmt bran cond sub pod time code
1             package Kossy::Exception;
2              
3 20     20   145 use strict;
  20         47  
  20         830  
4 20     20   96 use warnings;
  20         35  
  20         1207  
5 20     20   10836 use HTTP::Status;
  20         109812  
  20         6616  
6 20     20   3404 use Text::Xslate qw/html_escape/;
  20         94327  
  20         1611  
7 20     20   10101 use Kossy::Response;
  20         78  
  20         9399  
8              
9             our $VERSION = '0.63';
10              
11             sub new {
12 34     34 0 193 my $class = shift;
13 34         60 my $code = shift;
14 34         132 my %args = (
15             code => $code,
16             );
17 34 100       194 if ( @_ == 1 ) {
    100          
18 2         9 $args{message} = shift;
19             }
20             elsif ( @_ % 2 == 0) {
21 31         126 %args = (
22             %args,
23             @_
24             );
25             }
26 34         469 bless \%args, $class;
27             }
28              
29             sub response {
30 33     33 0 8071 my $self = shift;
31 33   100     149 my $code = $self->{code} || 500;
32              
33 33 100       118 if ($self->{response}) {
34 19         96 $self->{response}->code($code);
35 19         221 return $self->{response}->finalize;
36             }
37             else {
38 14         25 my $message = $self->{message};
39 14   66     64 $message ||= HTTP::Status::status_message($code);
40              
41 14         100 my @headers = (
42             'Content-Type' => q!text/html; charset=UTF-8!,
43             );
44              
45 14 100 100     88 if ($code =~ /^3/ && (my $loc = eval { $self->{location} })) {
  2         40  
46 1         4 push(@headers, Location => $loc);
47             }
48              
49 14         50 return Kossy::Response->new($code, \@headers, [$self->html($code,$message)])->finalize;
50             }
51             }
52              
53             sub html {
54 14     14 0 25 my $self = shift;
55 14         33 my ($code,$message) = @_;
56 14         195 $code = html_escape($code);
57 14         85 $message = html_escape($message);
58 14         275 return <
59            
60            
61            
62            
63            
75            
76            
77            

78             $code $message
79            

80            
81            
82            
83             EOF
84             }
85              
86             1;