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 8     8   97105 use strict;
  8         28  
  8         247  
4 8     8   41 use warnings;
  8         14  
  8         231  
5 8     8   43 use parent qw/Plack::Request/;
  8         11  
  8         44  
6 8     8   407196 use Hash::MultiValue;
  8         24  
  8         175  
7 8     8   41 use Encode;
  8         24  
  8         569  
8 8     8   51 use HTTP::Headers::Fast;
  8         20  
  8         179  
9 8     8   4280 use Kossy::Validator;
  8         16131  
  8         276  
10 8     8   60 use HTTP::Entity::Parser;
  8         21  
  8         225  
11 8     8   43 use WWW::Form::UrlEncoded qw/parse_urlencoded_arrayref build_urlencoded_utf8/;
  8         18  
  8         419  
12 8     8   47 use Cookie::Baker;
  8         16  
  8         11680  
13              
14             our $VERSION = '0.50';
15              
16             sub new {
17 29     29 1 62921 my($class, $env, %opts) = @_;
18 29 50 33     172 Carp::croak(q{$env is required})
19             unless defined $env && ref($env) eq 'HASH';
20              
21 29         195 bless {
22             %opts,
23             env => $env,
24             }, $class;
25             }
26              
27             sub new_response {
28 5     5 1 2560 my $self = shift;
29 5         537 require Kossy::Response;
30 5         31 Kossy::Response->new(@_);
31             }
32              
33             sub cookies {
34 7     7 1 2433 my $self = shift;
35              
36 7 100       24 return {} unless $self->env->{HTTP_COOKIE};
37              
38             # HTTP_COOKIE hasn't changed: reuse the parsed cookie
39 6 100 66     36 if ( $self->env->{'plack.cookie.parsed'}
40             && $self->env->{'plack.cookie.string'} eq $self->env->{HTTP_COOKIE}) {
41 4         41 return $self->env->{'plack.cookie.parsed'};
42             }
43              
44 2         27 $self->env->{'plack.cookie.string'} = $self->env->{HTTP_COOKIE};
45 2         12 $self->env->{'plack.cookie.parsed'} = crush_cookie($self->env->{'plack.cookie.string'});
46             }
47              
48              
49             sub request_body_parser {
50 7     7 0 10 my $self = shift;
51 7 50       20 unless (exists $self->{request_body_parser}) {
52 7         18 $self->{request_body_parser} = $self->_build_request_body_parser();
53             }
54 7         17 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   11 my $self = shift;
83 7 100       16 if ( $self->env->{'kossy.request.parse_json_body'} ) {
84 5         26 return $json_parser;
85             }
86 2         14 $default_parser;
87             }
88              
89             sub _parse_request_body {
90 11     11   44 my $self = shift;
91 11 100       22 if ( !$self->env->{CONTENT_TYPE} ) {
92 4         35 $self->env->{'kossy.request.body_parameters'} = [];
93 4         27 $self->env->{'plack.request.upload'} = Hash::MultiValue->new();
94 4         134 return;
95             }
96              
97 7         40 my ($params,$uploads) = $self->request_body_parser->parse($self->env);
98 7         3190 $self->env->{'kossy.request.body_parameters'} = $params;
99              
100 7         55 my $upload_hmv = Hash::MultiValue->new();
101 7         272 while ( my ($k,$v) = splice @$uploads, 0, 2 ) {
102 1         7 my %copy = %$v;
103 1         3 $copy{headers} = HTTP::Headers::Fast->new(@{$v->{headers}});
  1         11  
104 1         134 $upload_hmv->add($k, Plack::Request::Upload->new(%copy));
105             }
106 7         84 $self->env->{'plack.request.upload'} = $upload_hmv;
107             }
108              
109             sub uploads {
110 4     4 1 3004 my $self = shift;
111 4 50       14 unless ($self->env->{'plack.request.upload'}) {
112 0         0 $self->_parse_request_body;
113             }
114 4         22 $self->env->{'plack.request.upload'};
115             }
116              
117             sub body_parameters {
118 12     12 1 665 my ($self) = @_;
119             $self->env->{'kossy.request.body'} ||=
120 12   66     34 Hash::MultiValue->new(map { Encode::decode_utf8($_) } @{$self->_body_parameters()});
  10         156  
  11         68  
121             }
122              
123             sub query_parameters {
124 13     13 1 1568 my ($self) = @_;
125             $self->env->{'kossy.request.query'} ||=
126 13   66     31 Hash::MultiValue->new(map { Encode::decode_utf8($_) } @{$self->_query_parameters()});
  18         186  
  11         58  
127             }
128              
129             sub parameters {
130 19     19 1 4210 my $self = shift;
131 19   66     63 $self->env->{'kossy.request.merged'} ||= do {
132 11         72 Hash::MultiValue->new(
133             $self->query_parameters->flatten,
134             $self->body_parameters->flatten,
135             );
136             };
137             }
138              
139             sub _body_parameters {
140 11     11   17 my $self = shift;
141 11 100       24 unless ($self->env->{'kossy.request.body_parameters'}) {
142 10         53 $self->_parse_request_body;
143             }
144 11         45 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         49 parse_urlencoded_arrayref($self->env->{'QUERY_STRING'});
151             }
152 11         120 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 8 my $self = shift;
193 4   50     25 $self->{_base} ||= {};
194 4         16 my $base = $self->_uri_base;
195 4   33     67 $self->{_base}->{$base} ||= $self->SUPER::base;
196 4         746 $self->{_base}->{$base}->clone;
197             }
198              
199             sub uri_for {
200 4     4 0 52 my($self, $path, $args) = @_;
201 4         10 my $uri = $self->base;
202 4 100       29 my $base = $uri->path eq "/"
203             ? ""
204             : $uri->path;
205 4         69 my $query = '';
206 4 100       11 if ( $args ) {
207 2         21 $query = build_urlencoded_utf8($args);
208             }
209 4 100       21 $uri->path_query( $base . $path . (length $query ? "?$query" : ""));
210 4         153 $uri;
211             }
212              
213             sub validator {
214 0     0 0   my ($self, $rule) = @_;
215 0           Kossy::Validator->check($self,$rule);
216             }
217              
218             1;