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 8     8   26 use strict;
  8         8  
  8         174  
4 8     8   38 use warnings;
  8         7  
  8         156  
5 8     8   20 use parent qw/Plack::Response/;
  8         8  
  8         37  
6 8     8   58702 use Encode;
  8         10  
  8         467  
7 8     8   31 use HTTP::Headers::Fast;
  8         7  
  8         94  
8 8     8   30 use Cookie::Baker;
  8         9  
  8         3590  
9              
10             our $VERSION = '0.40';
11              
12             our $DIRECT;
13             our $SECURITY_HEADER = 1;
14              
15             sub new {
16 27     27 1 35 my ($class, $rc, $headers, $content) = @_;
17 27 100       127 if ( defined $headers ) {
18 23 100       61 if (ref $headers eq 'ARRAY') {
    50          
19 5 50       8 Carp::carp("Odd number of headers") if @$headers % 2 != 0;
20 5         13 $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 27 50       1095 defined $rc ? ( status => $rc ) : (),
    100          
    100          
27             defined $content ? ( body => $content ) : (),
28             defined $headers ? ( headers => $headers ) : (),
29             }, $class;
30             }
31              
32             sub headers {
33 23     23 1 32 my $self = shift;
34              
35 23 50       31 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 23   66     130 return $self->{headers} ||= HTTP::Headers::Fast->new();
46             }
47             }
48              
49             sub _body {
50 22     22   66 my $self = shift;
51 22         42 my $body = $self->body;
52 22 100       70 $body = [] unless defined $body;
53 22 100 33     78 if (!ref $body or Scalar::Util::blessed($body) && overload::Method($body, q("")) && !$body->can('getline')) {
      33        
      66        
54 14 100       36 return [ Encode::encode_utf8($body) ] if Encode::is_utf8($body);
55 9         94 return [ $body ];
56             } else {
57 8         79 return $body;
58             }
59             }
60              
61             sub finalize {
62 22     22 1 40 my $self = shift;
63 22 50       36 return $DIRECT if $DIRECT;
64 22 50       54 Carp::croak "missing status" unless $self->status();
65              
66 22         81 my @headers;
67             $self->headers->scan(sub{
68 30     30   1053 my ($k,$v) = @_;
69 30 50 66     92 return if $SECURITY_HEADER && $k eq 'X-XSS-Protection';
70 30         33 $v =~ s/\015\012[\040|\011]+/chr(32)/ge; # replace LWS with a single SP
  0         0  
71 30         53 $v =~ s/\015|\012//g; # remove CR and LF since the char is invalid here
72 30         57 push @headers, $k, $v;
73 22         32 });
74              
75 22         153 while (my($name, $val) = each %{$self->cookies}) {
  23         56  
76 1         9 my $cookie = bake_cookie($name, $val);
77 1         53 push @headers, 'Set-Cookie' => $cookie;
78             }
79              
80 22 100       172 push @headers, 'X-XSS-Protection' => 1 if $SECURITY_HEADER;
81              
82             return [
83 22         38 $self->status,
84             \@headers,
85             $self->_body,
86             ];
87             }
88              
89             1;