File Coverage

blib/lib/Archive/Har/Entry/Request.pm
Criterion Covered Total %
statement 21 169 12.4
branch 0 78 0.0
condition 0 30 0.0
subroutine 7 21 33.3
pod 11 12 91.6
total 39 310 12.5


line stmt bran cond sub pod time code
1             package Archive::Har::Entry::Request;
2              
3 1     1   4 use warnings;
  1         1  
  1         23  
4 1     1   4 use strict;
  1         0  
  1         12  
5 1     1   3 use Carp();
  1         0  
  1         9  
6 1     1   651 use Archive::Har::Entry::Header();
  1         1  
  1         14  
7 1     1   365 use Archive::Har::Entry::Cookie();
  1         2  
  1         19  
8 1     1   440 use Archive::Har::Entry::Request::QueryString();
  1         2  
  1         14  
9 1     1   327 use Archive::Har::Entry::Request::PostData();
  1         2  
  1         1083  
10              
11             our $VERSION = '0.21';
12              
13 0     0     sub _DOES_NOT_APPLY { return -1 }
14              
15             sub new {
16 0     0 1   my ( $class, $params ) = @_;
17 0           my $self = {};
18 0           bless $self, $class;
19 0 0         if ( defined $params ) {
20 0           $self->method( $params->{method} );
21 0           $self->url( $params->{url} );
22 0           $self->http_version( $params->{httpVersion} );
23 0           my @cookies;
24 0 0 0       if ( ( defined $params->{cookies} )
25             && ( ref $params->{cookies} eq 'ARRAY' ) )
26             {
27 0           foreach my $cookie ( @{ $params->{cookies} } ) {
  0            
28 0           push @cookies, Archive::Har::Entry::Cookie->new($cookie);
29             }
30             }
31 0           $self->cookies( \@cookies );
32 0           my @headers;
33 0 0 0       if ( ( defined $params->{headers} )
34             && ( ref $params->{headers} eq 'ARRAY' ) )
35             {
36 0           foreach my $header ( @{ $params->{headers} } ) {
  0            
37 0           push @headers, Archive::Har::Entry::Header->new($header);
38             }
39             }
40 0           $self->headers( \@headers );
41 0           my @query_string;
42 0 0 0       if ( ( defined $params->{queryString} )
43             && ( ref $params->{queryString} eq 'ARRAY' ) )
44             {
45 0           foreach my $query_string ( @{ $params->{queryString} } ) {
  0            
46 0           push @query_string,
47             Archive::Har::Entry::Request::QueryString->new($query_string);
48             }
49             }
50 0           $self->query_string( \@query_string );
51 0 0         if ( defined $params->{postData} ) {
52             $self->post_data(
53             Archive::Har::Entry::Request::PostData->new(
54             $params->{postData}
55             )
56 0           );
57             }
58 0           $self->headers_size( $params->{headersSize} );
59 0           $self->body_size( $params->{bodySize} );
60 0 0         if ( defined $params->{comment} ) {
61 0           $self->comment( $params->{comment} );
62             }
63 0           foreach my $key ( sort { $a cmp $b } keys %{$params} ) {
  0            
  0            
64 0 0         if ( $key =~ /^_[[:alnum:]]+$/smx ) { # private fields
65 0           $self->$key( $params->{$key} );
66             }
67             }
68             }
69 0           return $self;
70             }
71              
72             sub method {
73 0     0 1   my ( $self, $new ) = @_;
74 0           my $old = $self->{method};
75 0 0         if ( @_ > 1 ) {
76 0 0         $self->{method} = defined $new ? uc $new : $new;
77             }
78 0 0         if ( defined $old ) {
79 0           return $old;
80             }
81             else {
82 0           return 'GET';
83             }
84             }
85              
86             sub url {
87 0     0 1   my ( $self, $new ) = @_;
88 0           my $old = $self->{url};
89 0 0         if ( @_ > 1 ) {
90 0           $self->{url} = $new;
91             }
92 0 0         if ( defined $old ) {
93 0           return $old;
94             }
95             else {
96 0           return 'http://example.com/';
97             }
98             }
99              
100             sub http_version {
101 0     0 1   my ( $self, $new ) = @_;
102 0           my $old = $self->{httpVersion};
103 0 0         if ( @_ > 1 ) {
104 0 0         $self->{httpVersion} = defined $new ? uc $new : $new;
105             }
106 0 0         if ( defined $old ) {
107 0           return $old;
108             }
109             else {
110 0           return 'HTTP/0.9';
111             }
112             }
113              
114             sub cookies {
115 0     0 1   my ( $self, $new ) = @_;
116 0           my $old = $self->{cookies};
117 0 0         if ( @_ > 1 ) {
118 0           $self->{cookies} = $new;
119             }
120 0 0 0       if ( ( defined $old ) && ( ref $old eq 'ARRAY' ) ) {
121 0           return @{$old};
  0            
122             }
123             else {
124 0           return ();
125             }
126             }
127              
128             sub headers {
129 0     0 1   my ( $self, $new ) = @_;
130 0           my $old = $self->{headers};
131 0 0         if ( @_ > 1 ) {
132 0           $self->{headers} = $new;
133             }
134 0 0 0       if ( ( defined $old ) && ( ref $old eq 'ARRAY' ) ) {
135 0           return @{$old};
  0            
136             }
137             else {
138 0           return ();
139             }
140             }
141              
142             sub query_string {
143 0     0 1   my ( $self, $new ) = @_;
144 0           my $old = $self->{queryString};
145 0 0         if ( @_ > 1 ) {
146 0           $self->{queryString} = $new;
147             }
148 0 0 0       if ( ( defined $old ) && ( ref $old eq 'ARRAY' ) ) {
149 0           return @{$old};
  0            
150             }
151             else {
152 0           return ();
153             }
154             }
155              
156             sub post_data {
157 0     0 1   my ( $self, $new ) = @_;
158 0           my $old = $self->{postData};
159 0 0         if ( @_ > 1 ) {
160 0           $self->{postData} = $new;
161             }
162 0           return $old;
163             }
164              
165             sub headers_size {
166 0     0 1   my ( $self, $new ) = @_;
167 0           my $old = $self->{headersSize};
168 0 0         if ( @_ > 1 ) {
169 0 0 0       if ( ( defined $new ) && ( $new =~ /^(\d+)$/smx ) ) {
170 0           $self->{headersSize} = $1 + 0;
171             }
172             else {
173 0           $self->{headersSize} = _DOES_NOT_APPLY();
174             }
175             }
176 0 0 0       if ( ( defined $old ) && ( $old == _DOES_NOT_APPLY() ) ) {
177 0           return;
178             }
179             else {
180 0           return $old;
181             }
182             }
183              
184             sub body_size {
185 0     0 1   my ( $self, $new ) = @_;
186 0           my $old = $self->{bodySize};
187 0 0         if ( @_ > 1 ) {
188 0 0 0       if ( ( defined $new ) && ( $new =~ /^(\d+)$/smx ) ) {
189 0           $self->{bodySize} = $1 + 0;
190             }
191             else {
192 0           $self->{bodySize} = _DOES_NOT_APPLY();
193             }
194             }
195 0 0 0       if ( ( defined $old ) && ( $old == _DOES_NOT_APPLY() ) ) {
196 0           return;
197             }
198             else {
199 0           return $old;
200             }
201             }
202              
203             sub comment {
204 0     0 1   my ( $self, $new ) = @_;
205 0           my $old = $self->{comment};
206 0 0         if ( @_ > 1 ) {
207 0           $self->{comment} = $new;
208             }
209 0           return $old;
210             }
211              
212             sub AUTOLOAD {
213 0     0     my ( $self, $new ) = @_;
214              
215 0           my $name = $Archive::Har::Entry::Request::AUTOLOAD;
216 0           $name =~ s/.*://smx; # strip fully-qualified portion
217              
218 0           my $old;
219 0 0         if ( $name =~ /^_[[:alnum:]]+$/smx ) { # private fields
    0          
220 0           $old = $self->{$name};
221 0 0         if ( @_ > 1 ) {
222 0           $self->{$name} = $new;
223             }
224             }
225             elsif ( $name eq 'DESTROY' ) {
226             }
227             else {
228 0           Carp::croak(
229             "$name is not specified in the HAR 1.2 spec and does not start with an underscore"
230             );
231             }
232 0           return $old;
233             }
234              
235             sub TO_JSON {
236 0     0 0   my ($self) = @_;
237 0           my $json = {};
238 0           $json->{method} = $self->method();
239 0           $json->{url} = $self->url();
240 0           $json->{httpVersion} = $self->http_version();
241 0           $json->{cookies} = [ $self->cookies() ];
242 0           $json->{headers} = [ $self->headers() ];
243 0           $json->{queryString} = [ $self->query_string() ];
244 0 0         if ( defined $self->post_data() ) {
245 0           $json->{postData} = $self->post_data();
246             }
247 0 0         if ( defined $self->body_size() ) {
248 0           $json->{bodySize} = $self->body_size();
249 0 0         if ( $self->body_size() == 0 ) {
250 0           delete $json->{postData};
251             }
252             }
253             else {
254 0           $json->{bodySize} = _DOES_NOT_APPLY();
255             }
256 0 0         if ( defined $self->headers_size() ) {
257 0           $json->{headersSize} = $self->headers_size();
258             }
259             else {
260 0           $json->{headersSize} = _DOES_NOT_APPLY();
261             }
262 0 0         if ( defined $self->comment() ) {
263 0           $json->{comment} = $self->comment();
264             }
265 0           foreach my $key ( sort { $a cmp $b } keys %{$self} ) {
  0            
  0            
266 0 0         next if ( !defined $self->{$key} );
267 0 0         if ( $key =~ /^_[[:alnum:]]+$/smx ) { # private fields
268 0           $json->{$key} = $self->{$key};
269             }
270             }
271 0           return $json;
272             }
273              
274             1;
275             __END__