File Coverage

blib/lib/Kossy/Response.pm
Criterion Covered Total %
statement 50 58 86.2
branch 23 36 63.8
condition 8 15 53.3
subroutine 11 11 100.0
pod 3 3 100.0
total 95 123 77.2


line stmt bran cond sub pod time code
1             package Kossy::Response;
2              
3 16     16   106 use strict;
  16         38  
  16         500  
4 16     16   194 use warnings;
  16         38  
  16         528  
5 16     16   93 use parent qw/Plack::Response/;
  16         31  
  16         99  
6 16     16   186823 use Encode;
  16         71165  
  16         1285  
7 16     16   102 use HTTP::Headers::Fast;
  16         34  
  16         294  
8 16     16   71 use Cookie::Baker;
  16         36  
  16         10715  
9              
10             our $VERSION = '0.60';
11              
12             our $DIRECT;
13             our $SECURITY_HEADER = 1;
14              
15             sub new {
16 35     35 1 109 my ($class, $rc, $headers, $content) = @_;
17 35 100       96 if ( defined $headers ) {
18 31 100       121 if (ref $headers eq 'ARRAY') {
    50          
19 12 50       38 Carp::carp("Odd number of headers") if @$headers % 2 != 0;
20 12         51 $headers = HTTP::Headers::Fast->new(@$headers);
21             } elsif (ref $headers eq 'HASH') {
22 0         0 $headers = HTTP::Headers::Fast->new(%$headers);
23             }
24             }
25             bless {
26 35 50       1048 defined $rc ? ( status => $rc ) : (),
    100          
    100          
27             defined $content ? ( body => $content ) : (),
28             defined $headers ? ( headers => $headers ) : (),
29             }, $class;
30             }
31              
32             sub headers {
33 33     33 1 119 my $self = shift;
34              
35 33 50       81 if (@_) {
36 0         0 my $headers = shift;
37 0 0       0 if (ref $headers eq 'ARRAY') {
    0          
38 0 0       0 Carp::carp("Odd number of headers") if @$headers % 2 != 0;
39 0         0 $headers = HTTP::Headers::Fast->new(@$headers);
40             } elsif (ref $headers eq 'HASH') {
41 0         0 $headers = HTTP::Headers::Fast->new(%$headers);
42             }
43 0         0 return $self->{headers} = $headers;
44             } else {
45 33   66     314 return $self->{headers} ||= HTTP::Headers::Fast->new();
46             }
47             }
48              
49             sub _body {
50 30     30   165 my $self = shift;
51 30         92 my $body = $self->body;
52 30 100       156 $body = [] unless defined $body;
53 30 100 33     174 if (!ref $body or Scalar::Util::blessed($body) && overload::Method($body, q("")) && !$body->can('getline')) {
      33        
      66        
54 15 100       128 return [ Encode::encode_utf8($body) ] if Encode::is_utf8($body);
55 10         164 return [ $body ];
56             } else {
57 15         185 return $body;
58             }
59             }
60              
61             sub finalize {
62 30     30 1 135 my $self = shift;
63 30 50       86 return $DIRECT if $DIRECT;
64 30 50       143 Carp::croak "missing status" unless $self->status();
65              
66 30         189 my @headers;
67             $self->headers->scan(sub{
68 41     41   857 my ($k,$v) = @_;
69 41 50 66     157 return if $SECURITY_HEADER && $k eq 'X-XSS-Protection';
70 41         98 $v =~ s/\015\012[\040|\011]+/chr(32)/ge; # replace LWS with a single SP
  0         0  
71 41         153 $v =~ s/\015|\012//g; # remove CR and LF since the char is invalid here
72 41         133 push @headers, $k, $v;
73 30         77 });
74              
75 30         261 while (my($name, $val) = each %{$self->cookies}) {
  31         147  
76 1         14 my $cookie = bake_cookie($name, $val);
77 1         91 push @headers, 'Set-Cookie' => $cookie;
78             }
79              
80 30 100       410 push @headers, 'X-XSS-Protection' => 1 if $SECURITY_HEADER;
81              
82             return [
83 30         81 $self->status,
84             \@headers,
85             $self->_body,
86             ];
87             }
88              
89             1;