root/trunk/lib/Mungo/Request.pm

Revision 17, 4.0 kB (checked in by jesus, 6 years ago)

first whack at resolving mod_perl2 support. refs #8

Line 
1 package Mungo::Request;
2
3 # Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
4 # For information on licensing see:
5 #   https://labs.omniti.com/zetaback/trunk/LICENSE
6
7 use strict;
8 use Mungo::Cookie;
9 use Mungo::MultipartFormData;
10 eval "use APR::Table;";
11 our $AUTOLOAD;
12
13 sub new {
14   my $class = shift;
15   my $parent = shift;
16   my $r = $parent->{'Apache::Request'};
17   my $singleton = $r->pnotes(__PACKAGE__);
18   return $singleton if ($singleton);
19   my %core_data = (
20     'Apache::Request' => $r,
21     'Method' => $r->method,
22     'Mungo' => $parent,
23   );
24   my $cl = $r->can('headers_in') ? $r->headers_in->get('Content-length') :
25                                    $r->header_in('Content-length');
26   my $ct = $r->can('headers_in') ? $r->headers_in->get('Content-Type') :
27                                    $r->header_in('Content-Type');
28   if($r->method eq 'POST' && $cl) {
29     $core_data{TotalBytes} = $cl;
30     if($ct =~ /^multipart\/form-data             # multipart form data
31                \s*;\s*                           # followed by a
32                boundary=\"?([^\";,]+)\"?/x) {    # boundary phrase
33       my $boundary = $1;
34       $core_data{multipart_form} =
35         Mungo::MultipartFormData->new($r, $cl, $boundary);
36     }
37     elsif($ct eq 'application/x-www-form-urlencoded') {
38       $r->read($core_data{'form_content'}, $core_data{TotalBytes});
39     }
40   }
41   my %data;
42   $singleton = bless \%data, $class;
43   tie %data, 'Mungo::Arbiter::Response', $singleton, \%core_data;
44   $singleton->{Buffer} = $r->dir_config('MungoBuffer') || 0;
45   $r->pnotes(__PACKAGE__, $singleton);
46   return $singleton;
47 }
48
49 sub DESTROY {
50   my $self = shift;
51   $self->cleanse();
52 }
53
54 sub cleanse {
55   my $self = shift;
56   delete $self->{$_} for keys %$self;
57   untie %$self if tied %$self;
58 }
59
60 sub Cookies {
61   my $self = shift;
62   my $ccls = 'Mungo::Cookie';
63   my $cookie = $self->{$ccls} ||= $ccls->new($self->{'Apache::Request'});
64   return $cookie->__get(@_);
65 }
66 sub QueryString {
67   my $self = shift;
68   my (@params) = $self->{'Mungo'}->{'Apache::Request'}->args;
69   my %qs;
70   if(@params == 1) {
71     # in mod_perl2 ->args is just a string
72     %qs = (map { (split /=/, $_, 2) } (split /&/, $params[0]));
73   }
74   else {
75     # mod_perl1 splits it up for us
76     %qs = @params;
77   }
78   return exists($qs{$_[0]})?$qs{$_[0]}:undef if(@_);
79   return %qs if wantarray;
80   return \%qs;
81 }
82 sub decode_form {
83   my $class = ref $_[0] ? ref $_[0] : $_[0];
84   my $form_content = $_[1];
85   my $form = {};
86   return $form unless($form_content);
87   foreach my $kv (split /[&;]/, $form_content) {
88     my($k, $v) = map { s/\+/ /g;
89                        s/%([0-9a-f]{2})/chr(hex($1))/ige;
90                        $_;
91                      } split(/=/, $kv, 2);
92     if(ref $form->{$k}) {
93       push @{$form->{$k}}, $v;
94     }
95     else {
96       $form->{$k} = exists($form->{$k}) ? [$form->{$k}, $v] : $v;
97     }
98   }
99   return $form;
100 }
101 sub Form {
102   my $self = shift;
103   my $form;
104   if(!$self->{form_content} && !$self->{multipart_form}) {
105     return undef if(@_);
106     return () if wantarray;
107     return {};
108   }
109   unless(exists $self->{Form}) {
110     $self->{Form} = $self->decode_form($self->{form_content})
111       if($self->{form_content});
112     $self->{Form} = $self->{multipart_form} if($self->{multipart_form});
113   }
114   $form = $self->{Form};
115   return exists($form->{$_[0]})?$form->{$_[0]}:undef if(@_);
116   return %$form if wantarray;
117   return $form;
118 }
119
120 sub Params {
121   my $self = shift;
122   return $self->Form($_[0]) || $self->QueryString($_[0]) if(@_);
123   my %base = $self->QueryString();
124   my $overlay = $self->Form();
125   while(my ($k, $v) = each %$overlay) {
126     $base{$k} = $v;
127   }
128   return %base if wantarray;
129   return \%base;
130 }
131
132 sub ServerVariables {
133   my $self = shift;
134   my $var = shift;
135   if($var eq 'DOCUMENT_ROOT') {
136     return $self->{'Mungo'}->{'Apache::Request'}->document_root;
137   }
138   elsif($var eq 'HTTP_HOST') {
139     return $self->{'Mungo'}->{'Apache::Request'}->hostname;
140   }
141   return undef;
142 }
143
144 sub AUTOLOAD {
145   my $self = shift;
146   die unless(ref $self);
147   my $name = $AUTOLOAD;
148   $name =~ s/.*://;   # strip fully-qualified portion
149   die __PACKAGE__." does not implement $name";
150 }
151
152 1;
Note: See TracBrowser for help on using the browser.