File Coverage

blib/lib/Eve/HttpRequest/Psgi.pm
Criterion Covered Total %
statement 18 55 32.7
branch 0 8 0.0
condition n/a
subroutine 6 13 46.1
pod 7 7 100.0
total 31 83 37.3


line stmt bran cond sub pod time code
1             package Eve::HttpRequest::Psgi;
2              
3 8     8   43 use parent qw(Eve::HttpRequest);
  8         17  
  8         45  
4              
5 8     8   429 use strict;
  8         17  
  8         288  
6 8     8   46 use warnings;
  8         18  
  8         275  
7              
8 8     8   8337 use Hash::MultiValue;
  8         19007  
  8         289  
9 8     8   9698 use JSON::XS;
  8         39978  
  8         605  
10 8     8   8322 use Plack::Request;
  8         600217  
  8         5723  
11              
12             =head1 NAME
13              
14             B - an HTTP request adapter for the PSGI interface.
15              
16             =head1 SYNOPSIS
17              
18             use Eve::HttpRequest::Psgi;
19              
20             my $request = Eve::HttpRequest->new(
21             uri_constructor => sub { return Eve::Uri->new(@_); },
22             env_hash => $env_hash);
23              
24             my $uri = $request->get_uri();
25             my $method = $request->get_method();
26             my $param = $request->get_parameter(name => 'some_parameter');
27             my @param_list = $request->get_parameter(name => 'some_list');
28             my $cookie = $request->get_cookie(name => 'some_cookie');
29              
30             my $upload_hash = $request->get_upload(name => 'huge_file');
31              
32             =head1 DESCRIPTION
33              
34             The class adapts some functionality of the C module.
35              
36             =head3 Constructor arguments
37              
38             =over 4
39              
40             =item C
41              
42             a code reference returning a newly constructed URI
43              
44             =item C
45              
46             an environment hash that is supplied to an application by a PSGI handler.
47              
48             =back
49              
50             =head1 METHODS
51              
52             =head2 B
53              
54             =cut
55              
56             sub init {
57 0     0 1   my ($self, %arg_hash) = @_;
58 0           Eve::Support::arguments(
59             \%arg_hash, my ($uri_constructor, $env_hash));
60              
61 0           $self->{'cgi'} = Plack::Request->new($env_hash);
62 0           $self->{'_uri_constructor'} = $uri_constructor;
63              
64 0           $self->{'_body_parameters'} = Hash::MultiValue->from_mixed({
65 0           %{$self->cgi->query_parameters()->as_hashref_mixed()},
66 0           %{$self->cgi->body_parameters()->as_hashref_mixed()}});
67 0           $self->{'_cookies'} = $self->cgi->cookies();
68              
69 0 0         if ($self->cgi->headers->content_type() eq 'application/json') {
70 0           $self->_body_parameters = Hash::MultiValue->new(
71 0           %{$self->cgi->query_parameters()->as_hashref_mixed()},
72 0           %{JSON::XS->new()->utf8()->decode($self->cgi->content())});
73             }
74              
75 0           return;
76             }
77              
78             =head2 B
79              
80             Returns an URI instance built from an HTTP request URI.
81              
82             =cut
83              
84             sub get_uri {
85 0     0 1   my $self = shift;
86              
87 0           my $uri = $self->_uri_constructor->(
88             string => $self->cgi->uri()->canonical());
89              
90 0           $uri->set_query_hash(hash => $self->cgi->query_parameters()->as_hashref());
91              
92 0           return $uri;
93             }
94              
95             =head2 B
96              
97             Returns an HTTP method name.
98              
99             =cut
100              
101             sub get_method {
102 0     0 1   my $self = shift;
103              
104 0           return $self->cgi->method();
105             }
106              
107             =head2 B
108              
109             Returns a request parameter value or a list of values for a specified
110             parameter name. When called in a scalar context, will return a single
111             value, which for a multivalue parameter will result in a first value
112             of the list:
113              
114             my $parameter_value = $request->get_parameter(name => 'some');
115              
116             To receive a list of all values for a multivalue parameter, call the
117             method in a list context:
118              
119             my @parameter_value_list = $request->get_parameter(name => 'some');
120              
121             =head3 Arguments
122              
123             =over 4
124              
125             =item C
126              
127             =back
128              
129             =cut
130              
131             sub get_parameter {
132 0     0 1   my ($self, %arg_hash) = @_;
133 0           Eve::Support::arguments(\%arg_hash, my ($name));
134              
135 0           my @result = $self->_body_parameters->get_all($name);
136 0           my $result = $self->_body_parameters->get($name);
137              
138 0 0         if (scalar @result > 1) {
139 0           return @result;
140             } else {
141 0           return $result;
142             }
143             }
144              
145             =head2 B
146              
147             Returns a hash containing information about an uploaded file. This
148             hash will have C, C and C keys, values for
149             which represent the temporary file path, its size in bytes and the
150             original name of the file.
151              
152             =head3 Arguments
153              
154             =over 4
155              
156             =item C
157              
158             =back
159              
160             =cut
161              
162             sub get_upload {
163 0     0 1   my ($self, %arg_hash) = @_;
164 0           Eve::Support::arguments(\%arg_hash, my ($name));
165              
166 0           my $upload = $self->cgi->uploads->{$name};
167              
168 0 0         my $result = defined $upload ? {
169             'tempname' => $upload->tempname,
170             'size' => $upload->size,
171             'filename' => $upload->filename,
172             'content_type' => $upload->content_type} : undef;
173              
174 0           return $result;
175             }
176              
177             =head2 B
178              
179             Returns a hash reference with the requested parameter values.
180              
181             =cut
182              
183             sub get_parameter_hash {
184 0     0 1   my $self = shift;
185              
186 0           return $self->_body_parameters;
187             }
188              
189             =head2 B
190              
191             Returns a request cookie value for a specified name.
192              
193             =head3 Arguments
194              
195             =over 4
196              
197             =item C
198              
199             =back
200              
201             =cut
202              
203             sub get_cookie {
204 0     0 1   my ($self, %arg_hash) = @_;
205 0           Eve::Support::arguments(\%arg_hash, my ($name));
206              
207 0 0         my $result = defined $self->_cookies->{$name} ?
208             $self->_cookies->{$name} : undef;
209              
210 0           return $result;
211             }
212              
213             =head1 SEE ALSO
214              
215             =over 4
216              
217             =item C
218              
219             =item C
220              
221             =item C
222              
223             =back
224              
225             =head1 LICENSE AND COPYRIGHT
226              
227             Copyright 2012 Igor Zinovyev.
228              
229             This program is free software; you can redistribute it and/or modify it
230             under the terms of either: the GNU General Public License as published
231             by the Free Software Foundation; or the Artistic License.
232              
233             See http://dev.perl.org/licenses/ for more information.
234              
235              
236             =head1 AUTHORS
237              
238             =over 4
239              
240             =item L
241              
242             =item L
243              
244             =cut
245              
246             1;