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 21     21   145 use strict;
  21         42  
  21         818  
4 21     21   106 use warnings;
  21         40  
  21         1337  
5 21     21   120 use parent qw/Plack::Response/;
  21         68  
  21         181  
6 21     21   361478 use Encode;
  21         108196  
  21         2542  
7 21     21   169 use HTTP::Headers::Fast;
  21         39  
  21         537  
8 21     21   130 use Cookie::Baker;
  21         44  
  21         18705  
9              
10             our $VERSION = '0.63';
11              
12             our $DIRECT;
13             our $SECURITY_HEADER = 1;
14              
15             sub new {
16 93     93 1 282 my ($class, $rc, $headers, $content) = @_;
17 93 100       309 if ( defined $headers ) {
18 50 100       181 if (ref $headers eq 'ARRAY') {
    50          
19 15 50       53 Carp::carp("Odd number of headers") if @$headers % 2 != 0;
20 15         69 $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 93 50       1941 defined $rc ? ( status => $rc ) : (),
    100          
    100          
27             defined $content ? ( body => $content ) : (),
28             defined $headers ? ( headers => $headers ) : (),
29             }, $class;
30             }
31              
32             sub headers {
33 101     101 1 356 my $self = shift;
34              
35 101 50       234 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 101   66     1229 return $self->{headers} ||= HTTP::Headers::Fast->new();
46             }
47             }
48              
49             sub _body {
50 85     85   525 my $self = shift;
51 85         324 my $body = $self->body;
52 85 100       496 $body = [] unless defined $body;
53 85 100 33     478 if (!ref $body or Scalar::Util::blessed($body) && overload::Method($body, q("")) && !$body->can('getline')) {
      33        
      66        
54 28 100       149 return [ Encode::encode_utf8($body) ] if Encode::is_utf8($body);
55 23         407 return [ $body ];
56             } else {
57 57         928 return $body;
58             }
59             }
60              
61             sub finalize {
62 85     85 1 192 my $self = shift;
63 85 50       253 return $DIRECT if $DIRECT;
64 85 50       404 Carp::croak "missing status" unless $self->status();
65              
66 85         615 my @headers;
67             $self->headers->scan(sub{
68 70     70   1327 my ($k,$v) = @_;
69 70 50 66     287 return if $SECURITY_HEADER && $k eq 'X-XSS-Protection';
70 70         142 $v =~ s/\015\012[\040|\011]+/chr(32)/ge; # replace LWS with a single SP
  0         0  
71 70         229 $v =~ s/\015|\012//g; # remove CR and LF since the char is invalid here
72 70         236 push @headers, $k, $v;
73 85         297 });
74              
75 85         2035 while (my($name, $val) = each %{$self->cookies}) {
  86         451  
76 1         9 my $cookie = bake_cookie($name, $val);
77 1         134 push @headers, 'Set-Cookie' => $cookie;
78             }
79              
80 85 100       1278 push @headers, 'X-XSS-Protection' => 1 if $SECURITY_HEADER;
81              
82             return [
83 85         307 $self->status,
84             \@headers,
85             $self->_body,
86             ];
87             }
88              
89             1;