File Coverage

blib/lib/Any/Daemon/FCGI/Request.pm
Criterion Covered Total %
statement 15 35 42.8
branch 0 12 0.0
condition n/a
subroutine 5 11 45.4
pod 6 6 100.0
total 26 64 40.6


line stmt bran cond sub pod time code
1             # Copyrights 2013-2019 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution Any-Daemon-HTTP. Meta-POD processed
6             # with OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Any::Daemon::FCGI::Request;
10 1     1   17 use vars '$VERSION';
  1         1  
  1         48  
11             $VERSION = '0.29';
12              
13 1     1   5 use base 'HTTP::Request';
  1         2  
  1         107  
14              
15 1     1   6 use warnings;
  1         1  
  1         33  
16 1     1   4 use strict;
  1         2  
  1         19  
17              
18 1     1   16 use Log::Report 'any-daemon-http';
  1         2  
  1         8  
19              
20              
21             sub new($)
22 0     0 1   { my ($class, $args) = @_;
23 0 0         my $params = $args->{params} or panic;
24 0 0         my $role = $args->{role} or panic;
25            
26 0           my @headers;
27            
28             # Content-Type and Content-Length come specially
29             push @headers, 'Content-Type' => $params->{CONTENT_TYPE}
30 0 0         if exists $params->{CONTENT_TYPE};
31              
32             push @headers, 'Content-Length' => $params->{CONTENT_LENGTH}
33 0 0         if exists $params->{CONTENT_LENGTH};
34            
35             # Pull all the HTTP_FOO parameters as headers. These will be in all-caps
36             # and use _ for word separators, but HTTP::Headers can cope with that.
37 0           foreach (keys %$params)
38 0 0         { push @headers, $1 => $params->{$_} if m/^HTTP_(.*)$/;
39             }
40            
41             my $self = $class->SUPER::new
42             ( $params->{REQUEST_METHOD}
43             , $params->{REQUEST_URI}
44             , \@headers
45             , $args->{stdin}
46 0           );
47              
48 0           $self->protocol($params->{SERVER_PROTOCOL});
49              
50 0 0         $self->{ADFR_reqid} = $args->{request_id} or panic;
51 0           $self->{ADFR_params} = $params;
52 0           $self->{ADFR_role} = $role;
53 0           $self->{ADFR_data} = $args->{data};
54              
55 0           $self;
56             }
57              
58             #----------------
59              
60 0     0 1   sub request_id { shift->{ADFR_reqid} }
61 0     0 1   sub params() { shift->{ADFR_params} }
62 0     0 1   sub param($) { $_[0]->{ADFR_params}{$_[1]} }
63 0     0 1   sub role() { shift->{ADFR_role} }
64              
65              
66 0     0 1   sub data() { shift->{ADFR_data} }
67              
68             1;