File Coverage

blib/lib/Net/HTTP/Spore/Response.pm
Criterion Covered Total %
statement 62 63 98.4
branch 21 22 95.4
condition 3 5 60.0
subroutine 19 20 95.0
pod 13 16 81.2
total 118 126 93.6


line stmt bran cond sub pod time code
1             package Net::HTTP::Spore::Response;
2             $Net::HTTP::Spore::Response::VERSION = '0.07';
3             # ABSTRACT: Portable HTTP Response object for SPORE response
4              
5 33     33   257883 use strict;
  33         101  
  33         1095  
6 33     33   170 use warnings;
  33         57  
  33         1513  
7              
8             use overload
9 33         285 '@{}' => \&finalize,
10             '""' => \&to_string,
11 33     33   3907 fallback => 1;
  33         3672  
12              
13 33     33   11496 use HTTP::Headers;
  33         150647  
  33         18118  
14              
15             sub new {
16 39     39 1 2301 my ( $class, $rc, $headers, $body ) = @_;
17              
18 39         107 my $self = bless {}, $class;
19              
20 39 100       213 $self->status($rc) if defined $rc;
21 39 100       176 $self->body($body) if defined $body;
22 39   100     197 $self->headers( $headers || [] );
23 39         143 $self;
24             }
25              
26 6     6 1 19 sub code { shift->status(@_) }
27 2     2 1 8 sub content { shift->body(@_) }
28 10     10 1 38 sub env { shift->request->env }
29 5     5 1 32 sub content_type { shift->headers->content_type(@_) }
30 1     1 1 610 sub content_length { shift->headers->content_length(@_) }
31 0     0 1 0 sub location { shift->header->header( 'Location' => @_ ) }
32 19     19 0 62 sub is_success { shift->status =~ /^2\d\d$/ }
33              
34             sub status {
35 132     132 1 847 my $self = shift;
36 132 100       291 if (@_) {
37 39         575 $self->{status} = shift;
38             }
39             else {
40 93         419 return $self->{status};
41             }
42             }
43              
44             sub body {
45 76     76 1 590 my $self = shift;
46 76 100       166 if (@_) {
47 37         95 $self->{body} = shift;
48 37 100       125 if ( !defined $self->{raw_body} ) {
49 32         87 $self->{raw_body} = $self->{body};
50             }
51             }
52             else {
53 39         248 return $self->{body};
54             }
55             }
56              
57             sub raw_body {
58 4     4 1 10 my $self = shift;
59 4 100       7 if (@_) {
60 2         5 $self->{raw_body} = shift;
61             }else{
62 2         10 return $self->{raw_body};
63             }
64             }
65              
66             sub headers {
67 84     84 1 185 my $self = shift;
68 84 100       183 if (@_) {
69 39         63 my $headers = shift;
70 39 100       121 if ( ref $headers eq 'ARRAY' ) {
    50          
71 38         162 $headers = HTTP::Headers->new(@$headers);
72             }
73             elsif ( ref $headers eq 'HASH' ) {
74 1         5 $headers = HTTP::Headers->new(%$headers);
75             }
76 39         1448 $self->{headers} = $headers;
77             }
78             else {
79 45   33     224 return $self->{headers} ||= HTTP::Headers->new();
80             }
81             }
82              
83             sub request {
84 36     36 1 1733 my $self = shift;
85 36 100       101 if (@_) {
86 22         64 $self->{request} = shift;
87             }else{
88 14         364 return $self->{request};
89             }
90             }
91              
92             sub header {
93 10     10 1 87 my $self = shift;
94 10         32 $self->headers->header(@_);
95             }
96              
97             sub to_string {
98 24     24 0 514 my $self = shift;
99 24         98 my $status = "HTTP status: ".$self->{status};
100 24 100       97 if ($self->{body} =~ /read timeout/){
101 1         14 $status .= " - read timeout";
102             }
103 24         134 return $status;
104             }
105              
106             sub finalize {
107 17     17 0 411 my $self = shift;
108              
109             return [
110             $self->status,
111             +[
112             map {
113 17         50 my $k = $_;
  12         192  
114 12         28 map { ( $k => $_ ) } $self->headers->header($_);
  12         420  
115             } $self->headers->header_field_names
116             ],
117             $self->body,
118             ];
119             }
120              
121             1;
122              
123             __END__
124              
125             =pod
126              
127             =encoding UTF-8
128              
129             =head1 NAME
130              
131             Net::HTTP::Spore::Response - Portable HTTP Response object for SPORE response
132              
133             =head1 VERSION
134              
135             version 0.07
136              
137             =head1 SYNOPSIS
138              
139             use Net:HTTP::Spore::Response;
140              
141             my $response = Net::HTTP::Spore::Response->new(
142             200, ['Content-Type', 'application/json'], '{"foo":1}';
143             );
144             $response->request($request);
145              
146             =head1 DESCRIPTION
147              
148             Net::HTTP::Spore::Response create a HTTP response
149              
150             =head1 METHODS
151              
152             =over 4
153              
154             =item new
155              
156             my $res = Net::HTTP::Spore::Response->new;
157             my $res = Net::HTTP::Spore::Response->new($status);
158             my $res = Net::HTTP::Spore::Response->new($status, $headers);
159             my $res = Net::HTTP::Spore::Response->new($status, $headers, $body);
160              
161             Creates a new Net::HTTP::Spore::Response object.
162              
163             =item code
164              
165             =item status
166              
167             $res->status(200);
168             my $status = $res->status;
169              
170             Gets or sets the HTTP status of the response
171              
172             =item env
173              
174             $res->env($env);
175             my $env = $res->env;
176              
177             Gets or sets the environment for the response. Shortcut to C<< $res->request->env >>
178              
179             =item content
180              
181             =item body
182              
183             $res->body($body);
184             my $body = $res->body;
185              
186             Gets or sets the body for the response
187              
188             =item raw_body
189              
190             my $raw_body = $res->raw_body
191              
192             The raw_body value is the same as body when the body is sets for the first time.
193              
194             =item content_type
195              
196             $res->content_type('application/json');
197             my $ct = $res->content_type;
198              
199             Gets or sets the content type of the response body
200              
201             =item content_length
202              
203             $res->content_length(length($body));
204             my $cl = $res->content_length;
205              
206             Gets or sets the content type of the response body
207              
208             =item location
209              
210             $res->location('http://example.com');
211             my $location = $res->location;
212              
213             Gets or sets the location header for the response
214              
215             =item request
216              
217             $res->request($request);
218             $request = $res->request;
219              
220             Gets or sets the HTTP request that created the current HTTP response.
221              
222             =item headers
223              
224             $headers = $res->headers;
225             $res->headers(['Content-Type' => 'application/json']);
226              
227             Gets or sets HTTP response headers.
228              
229             =item header
230              
231             my $cl = $res->header('Content-Length');
232             $res->header('Content-Type' => 'application/json');
233              
234             Shortcut for C<< $res->headers->header >>.
235              
236             =item finalise
237              
238             my $res = Net::HTTP::Response->new($status, $headers, $body);
239             say "http status is ".$res->[0];
240              
241             Return an arrayref:
242              
243             =over 2
244              
245             =item status
246              
247             The first element of the array ref is the HTTP status
248              
249             =item headers
250              
251             The second element is an arrayref containing the list of HTTP headers
252              
253             =item body
254              
255             The third and final element is the body
256              
257             =back
258              
259             =back
260              
261             =head1 AUTHORS
262              
263             =over 4
264              
265             =item *
266              
267             Franck Cuny <franck.cuny@gmail.com>
268              
269             =item *
270              
271             Ash Berlin <ash@cpan.org>
272              
273             =item *
274              
275             Ahmad Fatoum <athreef@cpan.org>
276              
277             =back
278              
279             =head1 COPYRIGHT AND LICENSE
280              
281             This software is copyright (c) 2012 by Linkfluence.
282              
283             This is free software; you can redistribute it and/or modify it under
284             the same terms as the Perl 5 programming language system itself.
285              
286             =cut