File Coverage

blib/lib/Apache2/ASP/Request.pm
Criterion Covered Total %
statement 15 57 26.3
branch 0 18 0.0
condition 0 2 0.0
subroutine 5 13 38.4
pod 4 7 57.1
total 24 97 24.7


line stmt bran cond sub pod time code
1              
2             package Apache2::ASP::Request;
3              
4 23     23   228 use strict;
  23         35  
  23         689  
5 23     23   92 use warnings 'all';
  23         27  
  23         705  
6 23     23   100 use Carp 'confess';
  23         30  
  23         10276  
7              
8              
9             #==============================================================================
10             sub new
11             {
12 0     0 0   my ($class, %args) = @_;
13            
14 0           my $s = bless {
15             }, $class;
16            
17 0           return $s;
18             }# end new()
19              
20              
21             #==============================================================================
22             sub context
23             {
24 0     0 0   $Apache2::ASP::HTTPContext::ClassName->current;
25             }# end context()
26              
27              
28             #==============================================================================
29             sub ServerVariables
30             {
31 0     0 1   my $s = shift;
32 0 0         @_ ? $ENV{$_[0]} : \%ENV;
33             }# end ServerVariables()
34              
35              
36             #==============================================================================
37             sub Form
38             {
39 0     0 1   my $s = shift;
40            
41 0 0         if( my $cgi = $s->context->cgi )
42             {
43 0           my $form = { };
44 0           foreach my $param ( eval { $cgi->param } )
  0            
45             {
46 0           my @val = $cgi->param( $param );
47 0 0         $form->{$param} = scalar(@val) > 1 ? [ @val ] : $val[0];
48             }# end foreach()
49 0           return $s->{_form} = $form;
50             }
51             else
52             {
53 0   0       return $s->{_form} || { };
54             }# end if()
55             }# end Form()
56              
57              
58             #==============================================================================
59             sub QueryString
60             {
61 0     0 1   my $s = shift;
62            
63 0           return $s->context->r->args;
64             }# end QueryString()
65              
66              
67             #==============================================================================
68             sub Cookies
69             {
70 0     0 1   my $s = shift;
71            
72 0 0         return { } unless $s->context->headers_in->{cookie};
73            
74 0           my %out = ( );
75 0           foreach my $item ( split /;\s*/, $s->context->headers_in->{cookie} )
76             {
77 0           my ( $name, $val ) = map { $s->context->cgi->unescape( $_ ) } split /\=/, $item;
  0            
78 0           $out{$name} = $val;
79             }# end foreach()
80            
81 0 0         @_ ? $out{$_[0]} : \%out;
82             }# end Cookies()
83              
84              
85             #==============================================================================
86             sub FileUpload
87             {
88 0     0 0   my ($s, $field, $arg) = @_;
89            
90 0 0         confess "Request.FileUpload called without arguments"
91             unless defined($field);
92            
93 0           my $cgi = $s->context->cgi;
94            
95 0           my $ifh = $cgi->upload($field);
96 0           my %info = ();
97 0           my $upInfo = { };
98            
99 0 0         if( $cgi->isa('Apache2::ASP::SimpleCGI') )
100             {
101 23     23   117 no warnings 'uninitialized';
  23         27  
  23         1819  
102             %info = (
103             ContentType => $cgi->upload_info( $field, 'mime' ),
104             FileHandle => $ifh,
105 0           BrowserFile => $s->Form->{ $field } . "",
106             'Content-Disposition' => 'attachment',
107             'Mime-Header' => $cgi->upload_info( $field, 'mime' ),
108             );
109             }
110             else
111             {
112 0           $upInfo = $cgi->uploadInfo( $ifh );
113 23     23   108 no warnings 'uninitialized';
  23         32  
  23         3399  
114             %info = (
115             ContentType => $upInfo->{'Content-Type'},
116             FileHandle => $ifh,
117             BrowserFile => $s->Form->{ $field } . "",
118             'Content-Disposition' => $upInfo->{'Content-Disposition'},
119             'Mime-Header' => $upInfo->{type},
120 0           );
121             }# end if()
122            
123 0 0         if( wantarray )
124             {
125 0           return %info;
126             }
127             else
128             {
129 0 0         if( $arg )
130             {
131 0           return $info{ $arg };
132             }
133             else
134             {
135 0           return $ifh;
136             }# end if()
137             }# end if()
138              
139             }# end FileUpload()
140              
141              
142             #==============================================================================
143             sub DESTROY
144             {
145 0     0     my $s = shift;
146 0           undef(%$s);
147             }# end DESTROY()
148              
149             1;# return true:
150              
151             =pod
152              
153             =head1 NAME
154              
155             Apache2::ASP::Request - Incoming request object.
156              
157             =head1 SYNOPSIS
158              
159             my $form_args = $Request->Form;
160            
161             my $querystring = $Request->QueryString;
162            
163             my $cookies = $Request->Cookies;
164            
165             my $cookie = $Request->Cookies('name');
166            
167             my $vars = $Request->ServerVariables;
168            
169             my $var = $Request->ServerVariables('HTTP_HOST');
170              
171             =head1 DESCRIPTION
172              
173             The request represents a wrapper around incoming form, querystring and cookie data.
174              
175             =head1 PUBLIC METHODS
176              
177             =head2 ServerVariables( [$name] )
178              
179             If called with no arguments, returns C<%ENV>. If called with an argument, returns
180             C<$ENV{$name}> where C<$name> is the value of the argument.
181              
182             =head2 Cookies( [$name] )
183              
184             If called with no arguments, returns a hash of all cookies. Otherwise, returns
185             the value of the cookie named C<$name>.
186              
187             =head1 PUBLIC PROPERTIES
188              
189             =head2 Form
190              
191             Returns a hashref of all querystring and form data.
192              
193             =head2 QueryString
194              
195             Returns the querystring portion of the current request.
196              
197             =head1 BUGS
198            
199             It's possible that some bugs have found their way into this release.
200            
201             Use RT L to submit bug reports.
202            
203             =head1 HOMEPAGE
204            
205             Please visit the Apache2::ASP homepage at L to see examples
206             of Apache2::ASP in action.
207              
208             =head1 AUTHOR
209              
210             John Drago
211              
212             =head1 COPYRIGHT
213              
214             Copyright 2008 John Drago. All rights reserved.
215              
216             =head1 LICENSE
217              
218             This software is Free software and is licensed under the same terms as perl itself.
219              
220             =cut
221