File Coverage

lib/CGI/Mungo/Request.pm
Criterion Covered Total %
statement 28 57 49.1
branch 1 10 10.0
condition 0 3 0.0
subroutine 8 12 66.6
pod 3 4 75.0
total 40 86 46.5


line stmt bran cond sub pod time code
1             #request object
2             package CGI::Mungo::Request;
3              
4             =pod
5              
6             =head1 NAME
7              
8             CGI::Mungo::Request - Form request class
9              
10             =head1 SYNOPSIS
11              
12             my $r = $mungo->getRequest();
13             my $params = $r->getParameters();
14              
15             =head1 DESCRIPTION
16              
17             Class to deal with the current page request
18              
19             =head1 METHODS
20              
21             =cut
22              
23 3     3   18 use strict;
  3         4  
  3         131  
24 3     3   17 use warnings;
  3         6  
  3         304  
25 3     3   302823 use CGI;
  3         76436  
  3         25  
26 3     3   184 use Carp;
  3         5  
  3         234  
27 3     3   16 use Data::Dumper;
  3         6  
  3         1989  
28             #########################################################
29              
30             =head2 new()
31              
32             my $r = CGI::Mungo::Request->new();
33              
34             Constructor, gets all the GET/POST information from the browser request.
35              
36             =cut
37              
38             ##########################################
39             sub new{
40 2     2 1 6 my $class = shift;
41 2         9 my $self = {
42             '_parameters' => {},
43             '__cgi' => undef
44             };
45 2         7 bless $self, $class;
46 2         9 $self->_setParameters();
47 2         11 return $self;
48             }
49             #########################################################
50              
51             =pod
52              
53             =head2 getParameters()
54              
55             my $params = $r->getParameters();
56              
57             Returns a hash reference of all the GET/POST values from the current request.
58              
59             =cut
60              
61             ##########################################
62             sub getParameters{ #get POST or GET data
63 0     0 1 0 my $self = shift;
64 0         0 return $self->{'_parameters'};
65             }
66             #########################################################
67              
68             =pod
69              
70             =head2 validate()
71              
72             my $rules = {
73             'age' => {
74             'rule' => '^\d+$',
75             'friendly' => 'Your Age'
76             }
77             }; #the form validation rules
78             my($result, $errors) = $r->validate($rules);
79              
80             Validates all the current form fields against the provided hash reference.
81              
82             The hash reference contains akey for every field you are concerned about,
83             which is a reference to another hash containing two elements. The first is the
84             actaul matching rule. The second is the friendly name for the field used
85             in the error message, if a problem with the field is found.
86              
87             The method returns two values, first being a 0 or a 1 indicating the success of the form.
88             The second is a reference to a list of errors if any.
89              
90             =cut
91              
92             ##########################################
93             sub validate{ #checks %form againist the hash rules
94 0     0 1 0 my($self, $rules) = @_;
95 0         0 my %params = %{$self->getParameters()};
  0         0  
96 0         0 my @errors; #fields that have a problem
97 0         0 my $result = 0;
98 0 0       0 if($rules){
99 0         0 foreach my $key (keys %{$rules}){ #check each field
  0         0  
100 0 0 0     0 if(!$params{$key} || $params{$key} !~ m/$rules->{$key}->{'rule'}/){ #found an error
101 0         0 push(@errors, $rules->{$key}->{'friendly'});
102             }
103             }
104 0 0       0 if($#errors == -1){ #no errors
105 0         0 $result = 1;
106             }
107             }
108             else{
109 0         0 confess("No rules to validate form");
110             }
111 0         0 return($result, \@errors);
112             }
113             #########################################
114              
115             =pod
116              
117             =head2 getheader($header)
118              
119             $request->getHeader($name)
120              
121             Returns the value of the specified request header.
122              
123             =cut
124              
125             #########################################
126             sub getHeader{
127 0     0 0 0 my($self, $name) = @_;
128 0         0 my $value = undef;
129 0         0 $name = uc($name);
130 0         0 $name =~ s/\-/_/g;
131 0 0       0 if(defined($ENV{"HTTP_" . $name})){
132 0         0 $value = $ENV{'HTTP_' . $name};
133             }
134 0         0 return $value;
135             }
136             #########################################
137             sub _setParameters{
138 2     2   5 my $self = shift;
139 2         9 my $cgi = $self->__getCgi();
140 2         11 foreach my $param ($cgi->param()){
141 0         0 my $value = $cgi->param($param);
142 0         0 $self->{'_parameters'}->{$param} = $value; #save
143             }
144 2         33 return 1;
145             }
146             ################ss###########################################
147             sub __getCgi{
148 2     2   3 my $self = shift;
149 2 50       16 if(!$self->{'__cgi'}){
150 2         14 $self->{'__cgi'} = CGI->new(); #create a new cgi object
151             }
152 2         9795 return $self->{'__cgi'};
153             }
154             ####################################################
155             sub __stringfy{
156 0     0     my($self, $item) = @_;
157 0           local $Data::Dumper::Terse = 1;
158 0           local $Data::Dumper::Indent = 0;
159 0           return Dumper($item);
160             }
161             ###########################################################
162              
163             =pod
164              
165             =head1 Notes
166              
167             =head1 Author
168              
169             MacGyveR
170              
171             Development questions, bug reports, and patches are welcome to the above address
172              
173             =head1 Copyright
174              
175             Copyright (c) 2011 MacGyveR. All rights reserved.
176              
177             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
178              
179             =cut
180              
181             ##########################################
182             return 1;