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 15     15   105 use strict;
  15         28  
  15         436  
4 15     15   79 use warnings;
  15         30  
  15         388  
5 15     15   6820 use HTTP::Status;
  15         70545  
  15         3883  
6 15     15   2744 use Text::Xslate qw/html_escape/;
  15         62330  
  15         913  
7 15     15   6481 use Kossy::Response;
  15         45  
  15         5411  
8              
9             our $VERSION = '0.60';
10              
11             sub new {
12 18     18 0 54 my $class = shift;
13 18         28 my $code = shift;
14 18         50 my %args = (
15             code => $code,
16             );
17 18 100       102 if ( @_ == 1 ) {
    100          
18 2         4 $args{message} = shift;
19             }
20             elsif ( @_ % 2 == 0) {
21 15         62 %args = (
22             %args,
23             @_
24             );
25             }
26 18         121 bless \%args, $class;
27             }
28              
29             sub response {
30 17     17 0 5803 my $self = shift;
31 17   100     94 my $code = $self->{code} || 500;
32              
33 17 100       49 if ($self->{response}) {
34 6         23 $self->{response}->code($code);
35 6         59 return $self->{response}->finalize;
36             }
37             else {
38 11         19 my $message = $self->{message};
39 11   66     52 $message ||= HTTP::Status::status_message($code);
40              
41 11         77 my @headers = (
42             'Content-Type' => q!text/html; charset=UTF-8!,
43             );
44              
45 11 100 100     53 if ($code =~ /^3/ && (my $loc = eval { $self->{location} })) {
  2         13  
46 1         4 push(@headers, Location => $loc);
47             }
48              
49 11         58 return Kossy::Response->new($code, \@headers, [$self->html($code,$message)])->finalize;
50             }
51             }
52              
53             sub html {
54 11     11 0 18 my $self = shift;
55 11         28 my ($code,$message) = @_;
56 11         87 $code = html_escape($code);
57 11         52 $message = html_escape($message);
58 11         180 return <
59            
60            
61            
62            
63            
75            
76            
77            

78             $code $message
79            

80            
81            
82            
83             EOF
84             }
85              
86             1;