File Coverage

blib/lib/Kossy/Request.pm
Criterion Covered Total %
statement 99 123 80.4
branch 20 32 62.5
condition 11 23 47.8
subroutine 24 29 82.7
pod 8 15 53.3
total 162 222 72.9


line stmt bran cond sub pod time code
1             package Kossy::Request;
2              
3 11     11   84574 use strict;
  11         30  
  11         316  
4 11     11   55 use warnings;
  11         22  
  11         319  
5 11     11   58 use parent qw/Plack::Request/;
  11         24  
  11         61  
6 11     11   524285 use Hash::MultiValue;
  11         32  
  11         234  
7 11     11   57 use Encode;
  11         22  
  11         790  
8 11     11   66 use HTTP::Headers::Fast;
  11         24  
  11         253  
9 11     11   5337 use Kossy::Validator;
  11         21353  
  11         364  
10 11     11   81 use HTTP::Entity::Parser;
  11         22  
  11         268  
11 11     11   59 use WWW::Form::UrlEncoded qw/parse_urlencoded_arrayref build_urlencoded_utf8/;
  11         21  
  11         571  
12 11     11   65 use Cookie::Baker;
  11         21  
  11         15227  
13              
14             our $VERSION = '0.60';
15              
16             sub new {
17 30     30 1 61105 my($class, $env, %opts) = @_;
18 30 50 33     222 Carp::croak(q{$env is required})
19             unless defined $env && ref($env) eq 'HASH';
20              
21 30         322 bless {
22             %opts,
23             env => $env,
24             }, $class;
25             }
26              
27             sub new_response {
28 5     5 1 2369 my $self = shift;
29 5         458 require Kossy::Response;
30 5         30 Kossy::Response->new(@_);
31             }
32              
33             sub cookies {
34 7     7 1 2583 my $self = shift;
35              
36 7 100       28 return {} unless $self->env->{HTTP_COOKIE};
37              
38             # HTTP_COOKIE hasn't changed: reuse the parsed cookie
39 6 100 66     31 if ( $self->env->{'plack.cookie.parsed'}
40             && $self->env->{'plack.cookie.string'} eq $self->env->{HTTP_COOKIE}) {
41 4         42 return $self->env->{'plack.cookie.parsed'};
42             }
43              
44 2         28 $self->env->{'plack.cookie.string'} = $self->env->{HTTP_COOKIE};
45 2         13 $self->env->{'plack.cookie.parsed'} = crush_cookie($self->env->{'plack.cookie.string'});
46             }
47              
48              
49             sub request_body_parser {
50 7     7 0 12 my $self = shift;
51 7 50       19 unless (exists $self->{request_body_parser}) {
52 7         20 $self->{request_body_parser} = $self->_build_request_body_parser();
53             }
54 7         19 return $self->{request_body_parser};
55             }
56              
57             my $default_parser = HTTP::Entity::Parser->new();
58             $default_parser->register(
59             'application/x-www-form-urlencoded',
60             'HTTP::Entity::Parser::UrlEncoded'
61             );
62             $default_parser->register(
63             'multipart/form-data',
64             'HTTP::Entity::Parser::MultiPart'
65             );
66              
67             my $json_parser = HTTP::Entity::Parser->new();
68             $json_parser->register(
69             'application/x-www-form-urlencoded',
70             'HTTP::Entity::Parser::UrlEncoded'
71             );
72             $json_parser->register(
73             'multipart/form-data',
74             'HTTP::Entity::Parser::MultiPart'
75             );
76             $json_parser->register(
77             'application/json',
78             'HTTP::Entity::Parser::JSON'
79             );
80              
81             sub _build_request_body_parser {
82 7     7   12 my $self = shift;
83 7 100       16 if ( $self->env->{'kossy.request.parse_json_body'} ) {
84 5         33 return $json_parser;
85             }
86 2         14 $default_parser;
87             }
88              
89             sub _parse_request_body {
90 11     11   55 my $self = shift;
91 11 100       26 if ( !$self->env->{CONTENT_TYPE} ) {
92 4         19 $self->env->{'kossy.request.body_parameters'} = [];
93 4         19 $self->env->{'plack.request.upload'} = Hash::MultiValue->new();
94 4         121 return;
95             }
96              
97 7         42 my ($params,$uploads) = $self->request_body_parser->parse($self->env);
98 7         5996 $self->env->{'kossy.request.body_parameters'} = $params;
99              
100 7         50 my $upload_hmv = Hash::MultiValue->new();
101 7         267 while ( my ($k,$v) = splice @$uploads, 0, 2 ) {
102 1         7 my %copy = %$v;
103 1         5 $copy{headers} = HTTP::Headers::Fast->new(@{$v->{headers}});
  1         23  
104 1         136 $upload_hmv->add($k, Plack::Request::Upload->new(%copy));
105             }
106 7         75 $self->env->{'plack.request.upload'} = $upload_hmv;
107             }
108              
109             sub uploads {
110 4     4 1 3056 my $self = shift;
111 4 50       11 unless ($self->env->{'plack.request.upload'}) {
112 0         0 $self->_parse_request_body;
113             }
114 4         23 $self->env->{'plack.request.upload'};
115             }
116              
117             sub body_parameters {
118 12     12 1 730 my ($self) = @_;
119             $self->env->{'kossy.request.body'} ||=
120 12   66     37 Hash::MultiValue->new(map { Encode::decode_utf8($_) } @{$self->_body_parameters()});
  10         140  
  11         69  
121             }
122              
123             sub query_parameters {
124 13     13 1 1513 my ($self) = @_;
125             $self->env->{'kossy.request.query'} ||=
126 13   66     32 Hash::MultiValue->new(map { Encode::decode_utf8($_) } @{$self->_query_parameters()});
  18         170  
  11         63  
127             }
128              
129             sub parameters {
130 19     19 1 4058 my $self = shift;
131 19   66     68 $self->env->{'kossy.request.merged'} ||= do {
132 11         82 Hash::MultiValue->new(
133             $self->query_parameters->flatten,
134             $self->body_parameters->flatten,
135             );
136             };
137             }
138              
139             sub _body_parameters {
140 11     11   19 my $self = shift;
141 11 100       26 unless ($self->env->{'kossy.request.body_parameters'}) {
142 10         60 $self->_parse_request_body;
143             }
144 11         49 return $self->env->{'kossy.request.body_parameters'};
145             }
146             sub _query_parameters {
147 11     11   18 my $self = shift;
148 11 50       26 unless ( $self->env->{'kossy.request.query_parameters'} ) {
149             $self->env->{'kossy.request.query_parameters'} =
150 11         56 parse_urlencoded_arrayref($self->env->{'QUERY_STRING'});
151             }
152 11         137 return $self->env->{'kossy.request.query_parameters'};
153             }
154              
155             sub body_parameters_raw {
156 0     0 0 0 my $self = shift;
157 0 0       0 unless ($self->env->{'plack.request.body'}) {
158 0         0 $self->env->{'plack.request.body'} = Hash::MultiValue->new(@{$self->_body_parameters});
  0         0  
159             }
160 0         0 return $self->env->{'plack.request.body'};
161             }
162              
163             sub query_parameters_raw {
164 0     0 0 0 my $self = shift;
165 0 0       0 unless ($self->env->{'plack.request.query'}) {
166 0         0 $self->env->{'plack.request.query'} = Hash::MultiValue->new(@{$self->_query_parameters});
  0         0  
167             }
168 0         0 return $self->env->{'plack.request.query'};
169             }
170              
171             sub parameters_raw {
172 0     0 0 0 my $self = shift;
173 0   0     0 $self->env->{'plack.request.merged'} ||= do {
174             Hash::MultiValue->new(
175 0         0 @{$self->_query_parameters},
176 0         0 @{$self->_body_parameters}
  0         0  
177             );
178             };
179             }
180              
181             sub param_raw {
182 0     0 0 0 my $self = shift;
183              
184 0 0       0 return keys %{ $self->parameters_raw } if @_ == 0;
  0         0  
185              
186 0         0 my $key = shift;
187 0 0       0 return $self->parameters_raw->{$key} unless wantarray;
188 0         0 return $self->parameters_raw->get_all($key);
189             }
190              
191             sub base {
192 4     4 1 11 my $self = shift;
193 4   50     36 $self->{_base} ||= {};
194 4         21 my $base = $self->_uri_base;
195 4   33     89 $self->{_base}->{$base} ||= $self->SUPER::base;
196 4         768 $self->{_base}->{$base}->clone;
197             }
198              
199             sub uri_for {
200 4     4 0 69 my($self, $path, $args) = @_;
201 4         19 my $uri = $self->base;
202 4 100       33 my $base = $uri->path eq "/"
203             ? ""
204             : $uri->path;
205 4         75 my $query = '';
206 4 100       12 if ( $args ) {
207 2         29 $query = build_urlencoded_utf8($args);
208             }
209 4 100       27 $uri->path_query( $base . $path . (length $query ? "?$query" : ""));
210 4         196 $uri;
211             }
212              
213             sub validator {
214 0     0 0   my ($self, $rule) = @_;
215 0           Kossy::Validator->check($self,$rule);
216             }
217              
218             1;