File Coverage

blib/lib/Class/CGI/Handler.pm
Criterion Covered Total %
statement 32 34 94.1
branch 9 10 90.0
condition n/a
subroutine 8 9 88.8
pod 6 6 100.0
total 55 59 93.2


line stmt bran cond sub pod time code
1             package Class::CGI::Handler;
2              
3 2     2   7347 use strict;
  2         6  
  2         85  
4 2     2   12 use warnings;
  2         4  
  2         1068  
5              
6             =head1 NAME
7              
8             Class::CGI::Handler - Base class for Class::CGI handlers
9              
10             =head1 VERSION
11              
12             Version 0.20
13              
14             =cut
15              
16             our $VERSION = '0.20';
17              
18             =head1 SYNOPSIS
19              
20             use base 'Class::CGI::Handler';
21              
22             sub handle {
23             my $self = shift;
24             my $cgi = $self->cgi;
25             my $param = $self->param;
26             # validate stuff and return anything you want
27             }
28              
29             =head1 DESCRIPTION
30              
31             Handlers for C should inherit from this class. This class
32             provides a constructor which builds the handler object and checks to see if
33             the param value from the CGI data is required. If so, it will automatically
34             set a "missing" error if the parameter is not present. See the L
35             method for more details.
36              
37             =cut
38              
39             ##############################################################################
40              
41             =head1 Methods
42              
43             =head2 new
44              
45             my $handler = Some::Handler::Subclass->new( $cgi, $param );
46              
47             Returns a new handler object. Returns nothing if the parameter is required
48             but not present.
49              
50             =cut
51              
52             sub new {
53 2     2 1 943 my ( $class, $cgi, $param ) = @_;
54 2         15 my $self = bless {
55             cgi => $cgi,
56             param => $param,
57             }, $class;
58 2 50       13 if ( $cgi->is_required($param) ) {
59 2 100       41 return unless $self->has_param;
60             }
61 1         5 return $self->handle;
62             }
63              
64             ##############################################################################
65              
66             =head2 has_param
67              
68             if ( $handler->has_param ) {
69             ...
70             }
71              
72             Returns a boolean value indicating whether or not the current parameter was
73             found in the form. If a parameter is "real", that is to say, the requested
74             parameter name and the actual parameter name are identical, then this method
75             should be all you need. For example:
76              
77             In the HTML:
78              
79            
80              
81             In the code:
82              
83             my $age = $cgi->param('age');
84              
85             If the parameter is "virtual" (the requested parameter name does not match the
86             name in the HTML), then this method should be overridden in your subclass.
87              
88             Note that the this method will automatically report the parameter as "missing"
89             to the C object if it's a required parameter.
90              
91             =cut
92              
93             sub has_param {
94 2     2 1 6 my $self = shift;
95 2         10 my $param = $self->param;
96 2 100       14 return 1 unless $self->_missing($param);
97 1         4 $self->cgi->add_missing($param);
98 1         44 return;
99             }
100              
101             ##############################################################################
102              
103             =head2 has_virtual_param
104              
105             if ( $cgi->has_virtual_param( $param, @list_of_parameters ) ) {
106             }
107              
108             Very similar to the C method. However, instead of checking to see
109             if the current parameter exists, you pass in the name of the virtual parameter
110             and a list of the component parameters which comprise the virtual parameter.
111             For example:
112              
113             if ( $handler->has_virtual_param( 'date', qw/day month year/ ) ) {
114             ....
115             }
116              
117             Note that the this method will automatically report the parameter as "missing"
118             to the C object if it's a required parameter.
119              
120             =cut
121              
122             sub has_virtual_param {
123 2     2 1 11 my ( $self, $param, @components ) = @_;
124 2 100       12 if ( my %missing = $self->_missing(@components) ) {
125 1         4 my @missing = grep { exists $missing{$_} } @components;
  3         28  
126 1         7 $self->cgi->add_missing(
127             $param,
128             "The '$param' is missing values for (@missing)"
129             );
130 1         10 return;
131             }
132 1         7 return 1;
133             }
134              
135             ##############################################################################
136              
137             =head2 handle
138              
139             return $handler->handle;
140              
141             This method must be overridden in a subclass. It is the primary method used
142             to actually validate and optionally untaint form data and return the
143             appropriate data. See C in the L documentation.
144              
145             =cut
146              
147             sub handle {
148 0     0 1 0 require Carp;
149 0         0 Carp::croak("You must override the Class::CGI::handle() method");
150             }
151              
152             ##############################################################################
153              
154             =head2 cgi
155              
156             my $cgi = $handler->cgi;
157              
158             Returns the C object used to call the handler.
159              
160             =cut
161              
162 8     8 1 1947 sub cgi { shift->{cgi} }
163              
164             ##############################################################################
165              
166             =head2 param
167              
168             my $param = $cgi->param;
169              
170             Returns the parameter name the user has requested.
171              
172             =cut
173              
174 4     4 1 23 sub param { shift->{param} }
175              
176             ##############################################################################
177              
178             =head2 _missing
179              
180             if ( my %missing = $handler->_missing(@params) ) {
181             ...
182             }
183              
184             This is a protected method which should only be called by subclasses.
185              
186             Given a list of parameter names (actual, not virtual), this method will return
187             a hash of all parameters whose value is undefined or the empty string. The
188             keys are the parameter names and the values are the value received from the
189             C object.
190              
191             =cut
192              
193             sub _missing {
194 4     4   12 my ( $self, @params ) = @_;
195 4         16 my $cgi = $self->cgi;
196 2         14 my %missing =
197 7 100       104 map { $_->[0], $_->[1] } # prevent the "odd number of elements" warning
198 7         80 grep { !defined $_->[1] || '' eq $_->[1] }
199 4         14 map { [ $_, $cgi->raw_param($_) ] } @params;
200 4         38 return %missing;
201             }
202              
203             =head1 TODO
204              
205             This module should be considered alpha code. It probably has bugs. Comments
206             and suggestions welcome.
207              
208             The only current "TODO" is to allow overridding error messages.
209              
210             =head1 AUTHOR
211              
212             Curtis "Ovid" Poe, C<< >>
213              
214             =head1 SUPPORT
215              
216             There is a mailing list at L.
217             Currently it is low volume. That might change in the future.
218              
219             =head1 BUGS
220              
221             Please report any bugs or feature requests to
222             C, or through the web interface at
223             L.
224             I will be notified, and then you'll automatically be notified of progress on
225             your bug as I make changes.
226              
227             If you are unsure if a particular behavior is a bug, feel free to send mail to
228             the mailing list.
229              
230             =head1 COPYRIGHT & LICENSE
231              
232             Copyright 2006 Curtis "Ovid" Poe, all rights reserved.
233              
234             This program is free software; you can redistribute it and/or modify it
235             under the same terms as Perl itself.
236              
237             =cut
238              
239             1;