File Coverage

blib/lib/Plack/Response.pm
Criterion Covered Total %
statement 83 85 97.6
branch 21 24 87.5
condition 14 16 87.5
subroutine 23 25 92.0
pod 11 13 84.6
total 152 163 93.2


line stmt bran cond sub pod time code
1             package Plack::Response;
2 19     19   496153 use strict;
  19         96  
  19         588  
3 19     19   103 use warnings;
  19         95  
  19         922  
4             our $VERSION = '1.0048';
5              
6 19     19   8358 use Plack::Util::Accessor qw(body status);
  19         54  
  19         119  
7 19     19   116 use Carp ();
  19         38  
  19         273  
8 19     19   3864 use Cookie::Baker ();
  19         27240  
  19         353  
9 19     19   111 use Scalar::Util ();
  19         36  
  19         350  
10 19     19   4321 use HTTP::Headers::Fast;
  19         53614  
  19         613  
11 19     19   140 use URI::Escape ();
  19         50  
  19         19074  
12              
13 6     6 0 853 sub code { shift->status(@_) }
14 6     6 0 346 sub content { shift->body(@_) }
15              
16             sub new {
17 41     41 1 16525 my($class, $rc, $headers, $content) = @_;
18              
19 41         111 my $self = bless {}, $class;
20 41 100       225 $self->status($rc) if defined $rc;
21 41 100       113 $self->headers($headers) if defined $headers;
22 41 100       97 $self->body($content) if defined $content;
23              
24 41         180 $self;
25             }
26              
27             sub headers {
28 65     65 1 107 my $self = shift;
29              
30 65 100       146 if (@_) {
31 4         5 my $headers = shift;
32 4 100       18 if (ref $headers eq 'ARRAY') {
    100          
33 1 50       4 Carp::carp("Odd number of headers") if @$headers % 2 != 0;
34 1         8 $headers = HTTP::Headers::Fast->new(@$headers);
35             } elsif (ref $headers eq 'HASH') {
36 1         5 $headers = HTTP::Headers::Fast->new(%$headers);
37             }
38 4         114 return $self->{headers} = $headers;
39             } else {
40 61   66     372 return $self->{headers} ||= HTTP::Headers::Fast->new();
41             }
42             }
43              
44             sub cookies {
45 47     47 1 116 my $self = shift;
46 47 100       114 if (@_) {
47 1         5 $self->{cookies} = shift;
48             } else {
49 46   100     339 return $self->{cookies} ||= +{ };
50             }
51             }
52              
53 8     8 1 244 sub header { shift->headers->header(@_) } # shortcut
54              
55             sub content_length {
56 0     0 1 0 shift->headers->content_length(@_);
57             }
58              
59             sub content_type {
60 10     10 1 76 shift->headers->content_type(@_);
61             }
62              
63             sub content_encoding {
64 0     0 1 0 shift->headers->content_encoding(@_);
65             }
66              
67             sub location {
68 7     7 1 40 my $self = shift;
69 7         12 return $self->headers->header('Location' => @_);
70             }
71              
72             sub redirect {
73 3     3 1 14 my $self = shift;
74              
75 3 50       8 if (@_) {
76 3         5 my $url = shift;
77 3   100     10 my $status = shift || 302;
78 3         12 $self->location($url);
79 3         153 $self->status($status);
80             }
81              
82 3         8 return $self->location;
83             }
84              
85             sub finalize {
86 36     36 1 155 my $self = shift;
87 36 50       109 Carp::croak "missing status" unless $self->status();
88              
89 36         94 my $headers = $self->headers;
90 36         305 my @headers;
91             $headers->scan(sub{
92 17     17   355 my ($k,$v) = @_;
93 17         51 $v =~ s/\015\012[\040|\011]+/chr(32)/ge; # replace LWS with a single SP
  2         6  
94 17         74 $v =~ s/\015|\012//g; # remove CR and LF since the char is invalid here
95 17         55 push @headers, $k, $v;
96 36         289 });
97              
98 36         544 $self->_finalize_cookies(\@headers);
99              
100             return [
101 36         109 $self->status,
102             \@headers,
103             $self->_body,
104             ];
105             }
106              
107             sub to_app {
108 1     1 1 5 my $self = shift;
109 1     1   11 return sub { $self->finalize };
  1         7  
110             }
111              
112              
113             sub _body {
114 36     36   69 my $self = shift;
115 36         104 my $body = $self->body;
116 36 100       105 $body = [] unless defined $body;
117 36 100 66     257 if (!ref $body or Scalar::Util::blessed($body) && overload::Method($body, q("")) && !$body->can('getline')) {
      100        
      100        
118 15         323 return [ $body ];
119             } else {
120 21         374 return $body;
121             }
122             }
123              
124             sub _finalize_cookies {
125 36     36   80 my($self, $headers) = @_;
126              
127 36         54 foreach my $name ( keys %{ $self->cookies } ) {
  36         111  
128 6         17 my $val = $self->cookies->{$name};
129              
130 6         28 my $cookie = Cookie::Baker::bake_cookie( $name, $val );
131 6         492 push @$headers, 'Set-Cookie' => $cookie;
132             }
133             }
134              
135             1;
136             __END__