File Coverage

blib/lib/Eve/HttpResponse/Psgi.pm
Criterion Covered Total %
statement 76 76 100.0
branch 4 4 100.0
condition n/a
subroutine 19 19 100.0
pod 7 7 100.0
total 106 106 100.0


line stmt bran cond sub pod time code
1             package Eve::HttpResponse::Psgi;
2              
3 9     9   223011 use parent qw(Eve::HttpResponse);
  9         24  
  9         82  
4              
5 9     9   351 use utf8;
  9         26  
  9         85  
6 9     9   201 use strict;
  9         18  
  9         238  
7 9     9   838 use autodie;
  9         16013  
  9         74  
8 9     9   55329 use warnings;
  9         26  
  9         346  
9 9     9   856 use open qw(:std :utf8);
  9         1165  
  9         84  
10 9     9   2093 use charnames qw(:full);
  9         48485  
  9         79  
11              
12 9     9   13585 use HTTP::Status;
  9         39664  
  9         3518  
13 9     9   1267 use Encode ();
  9         11904  
  9         151  
14 9     9   8002 use Plack::Response ();
  9         30769  
  9         5586  
15              
16             =head1 NAME
17              
18             B - an HTTP response adapter.
19              
20             =head1 SYNOPSIS
21              
22             use Eve::HttpResponse;
23              
24             my $response = Eve::HttpResponse->new(nph_mode => 0);
25              
26             $response->set_status(code => 302);
27             $response->set_header(name => 'Location', value => '/other');
28             $response->set_cookie(
29             name => 'cookie1',
30             value => 'value',
31             domain => '.example.com',
32             path => '/some/',
33             expires => '+1d',
34             secure = >1);
35             $response->set_body(text => 'Hello world!');
36              
37             print $response->get_text();
38              
39             =head1 DESCRIPTION
40              
41             The class is an adapter for the Plack::Request module. It is used to
42             store the response data before it is being sent to the client.
43              
44             =head1 METHODS
45              
46             =head2 B
47              
48             =cut
49              
50             sub init {
51 11     11 1 21 my $self = shift;
52              
53 11         57 $self->{'_psgi'} = Plack::Response->new(200);
54 11         264 $self->SUPER::init();
55              
56 11         20 return;
57             }
58              
59             =head2 B
60              
61             Sets or overwrites an HTTP header of the response.
62              
63             =head3 Arguments
64              
65             =over 4
66              
67             =item C
68              
69             =item C
70              
71             =back
72              
73             =cut
74              
75             sub set_header {
76 8     8 1 2129 my ($self, %arg_hash) = @_;
77 8         35 Eve::Support::arguments(\%arg_hash, my ($name, $value));
78              
79 8 100       131 if ($name =~ /encoding|charset/i) {
80 4         21 my $enc = Encode::find_encoding($value);
81 4 100       7213 if (not defined $enc) {
82 1         23 Eve::Error::Value->throw(message => 'Unknown charset: '.$value);
83             }
84 3         143 $value = $enc->mime_name();
85             }
86              
87 7         2458 $self->_psgi->header($name => $value);
88              
89 7         521 return;
90             }
91              
92             =head2 B
93              
94             Sets or overwrites the HTTP response status.
95              
96             =head3 Arguments
97              
98             =over 4
99              
100             =item C
101              
102             =back
103              
104             =cut
105              
106             sub set_status {
107 4     4 1 2115 my ($self, %arg_hash) = @_;
108 4         19 Eve::Support::arguments(\%arg_hash, my $code);
109              
110 4         78 $self->_psgi->status($code);
111              
112 4         50 return;
113             }
114              
115             =head2 B
116              
117             Sets an HTTP response cookie.
118              
119             =head3 Arguments
120              
121             =over 4
122              
123             =item C
124              
125             =item C
126              
127             =item C
128              
129             =item C
130              
131             =item C
132              
133             (optional) a cookie expiration time in the epoch format
134              
135             =item C
136              
137             (optional) defaults to false
138              
139             =back
140              
141             =cut
142              
143             sub set_cookie {
144 5     5 1 395 my ($self, %arg_hash) = @_;
145 5         142 Eve::Support::arguments(\%arg_hash,
146             my ($name, $value), my $path = '/',
147             my ($domain, $expires, $secure) = ((\undef) x 3));
148              
149 5         102 $self->_psgi->cookies->{$name} = {
150             value => $value,
151             path => $path,
152             domain => $domain,
153             expires => $expires,
154             secure => $secure
155             };
156              
157 5         89 return;
158             }
159              
160             =head2 B
161              
162             Sets or overwrites the HTTP response body.
163              
164             =head3 Arguments
165              
166             =over 4
167              
168             =item C
169              
170             =back
171              
172             =cut
173              
174             sub set_body {
175 3     3 1 878 my ($self, %arg_hash) = @_;
176 3         11 Eve::Support::arguments(\%arg_hash, my $text);
177              
178 9     9   71 use bytes;
  9         20  
  9         84  
179 3         48 $self->_psgi->body($text);
180 3         41 $self->_psgi->content_length(length $text);
181 9     9   414 no bytes;
  9         19  
  9         71  
182              
183 3         124 return;
184             }
185              
186             =head2 B
187              
188             =head3 Returns
189              
190             The HTTP response as text.
191              
192             =cut
193              
194             sub get_text {
195 12     12 1 1727 my $self = shift;
196              
197 12         67 my $result = $self->_psgi->finalize();
198 12         1378 my $headers = '';
199              
200 12         20 while(@{$result->[1]}) {
  24         70  
201 12         15 my $name = shift(@{$result->[1]});
  12         26  
202 12         21 my $value = shift(@{$result->[1]});
  12         22  
203              
204 12         43 $headers .= $name . ": " . $value . "\r\n";
205             }
206              
207             return
208 12         191 "Status: " . $result->[0] . " "
209             . HTTP::Status::status_message($result->[0]) . "\r\n"
210             . $headers . "\r\n"
211 12         77 . join("\r\n", @{$result->[2]});
212             }
213              
214             =head2 B
215              
216             =head3 Returns
217              
218             The passthrough method for the Plack::Request C method.
219              
220             =cut
221              
222             sub get_raw_list {
223 1     1 1 6 my $self = shift;
224              
225 1         6 return $self->_psgi->finalize();
226             }
227              
228             =head1 SEE ALSO
229              
230             =over 4
231              
232             =item C
233              
234             =item C
235              
236             =item C
237              
238             =item C
239              
240             =back
241              
242             =head1 LICENSE AND COPYRIGHT
243              
244             Copyright 2012 Igor Zinovyev.
245              
246             This program is free software; you can redistribute it and/or modify it
247             under the terms of either: the GNU General Public License as published
248             by the Free Software Foundation; or the Artistic License.
249              
250             See http://dev.perl.org/licenses/ for more information.
251              
252              
253             =head1 AUTHORS
254              
255             =over 4
256              
257             =item L
258              
259             =back
260              
261             =cut
262              
263             1;