File Coverage

blib/lib/AppConfig/CGI.pm
Criterion Covered Total %
statement 38 50 76.0
branch 10 20 50.0
condition n/a
subroutine 7 8 87.5
pod 0 2 0.0
total 55 80 68.8


line stmt bran cond sub pod time code
1             package AppConfig::CGI;
2              
3             #============================================================================
4             #
5             # AppConfig::CGI.pm
6             #
7             # Perl5 module to provide a CGI interface to AppConfig. Internal variables
8             # may be set through the CGI "arguments" appended to a URL.
9             #
10             # Written by Andy Wardley <abw@wardley.org>
11             #
12             # Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
13             # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
14             #
15             # $Id: CGI.pm,v 1.60 2003/04/29 10:43:50 abw Exp $
16             #
17             #============================================================================
18              
19             require 5.004;
20              
21 1     1   23 use AppConfig::State;
  1         10  
  1         25  
22 1     1   17 use strict;
  1         9  
  1         20  
23              
24 1     1   15 use vars qw( $VERSION );
  1         8  
  1         14  
25             BEGIN {
26 1     1   13 $VERSION = '1.64';
27             }
28              
29             #------------------------------------------------------------------------
30             # new($state, $query)
31             #
32             # Module constructor. The first, mandatory parameter should be a
33             # reference to an AppConfig::State object to which all actions should
34             # be applied. The second parameter may be a string containing a CGI
35             # QUERY_STRING which is then passed to parse() to process. If no second
36             # parameter is specifiied then the parse() process is skipped.
37             #
38             # Returns a reference to a newly created AppConfig::CGI object.
39             #------------------------------------------------------------------------
40              
41             sub new {
42 1     1 0 22     my $class = shift;
43 1         10     my $state = shift;
44              
45                 
46 1         13     my $self = {
47                     STATE => $state, # AppConfig::State ref
48             DEBUG    => $state->_debug(), # store local copy of debug
49             PEDANTIC => $state->_pedantic, # and pedantic flags
50                };
51              
52 1         12     bless $self, $class;
53            
54             # call parse(@_) to parse any arg list passed
55 1 50       12     $self->parse(@_)
56             if @_;
57              
58 1         12     return $self;
59             }
60              
61              
62             #------------------------------------------------------------------------
63             # parse($query)
64             #
65             # Method used to parse a CGI QUERY_STRING and set internal variable
66             # values accordingly. If a query is not passed as the first parameter,
67             # then _get_cgi_query() is called to try to determine the query by
68             # examing the environment as per CGI protocol.
69             #
70             # Returns 0 if one or more errors or warnings were raised or 1 if the
71             # string parsed successfully.
72             #------------------------------------------------------------------------
73              
74             sub parse {
75 2     2 0 81     my $self = shift;
76 2         18     my $query = shift;
77 2         19     my $warnings = 0;
78 2         17     my ($variable, $value, $nargs);
79                 
80              
81             # take a local copy of the state to avoid much hash dereferencing
82 2         23     my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
83              
84             # get the cgi query if not defined
85                 $query = $ENV{ QUERY_STRING }
86 2 100       25 unless defined $query;
87              
88             # no query to process
89 2 50       64     return 1 unless defined $query;
90              
91             # we want to install a custom error handler into the AppConfig::State
92             # which appends filename and line info to error messages and then
93             # calls the previous handler; we start by taking a copy of the
94             # current handler..
95 2         27     my $errhandler = $state->_ehandler();
96              
97             # install a closure as a new error handler
98                 $state->_ehandler(
99             sub {
100             # modify the error message
101 0     0   0 my $format = shift;
102 0         0 $format =~ s/</&lt;/g;
103 0         0 $format =~ s/>/&gt;/g;
104 0         0 $format  = "<p>\n<b>[ AppConfig::CGI error: </b>$format<b> ] </b>\n<p>\n";
105             # send error to stdout for delivery to web client
106 0         0 printf($format, @_);
107             }
108 2         25     );
109              
110              
111 2         26     PARAM: foreach (split('&', $query)) {
112              
113             # extract parameter and value from query token
114 6         62 ($variable, $value) = map { _unescape($_) } split('=');
  11         98  
115              
116             # check an argument was provided if one was expected
117 6 100       123 if ($nargs = $state->_argcount($variable)) {
118 4 50       43 unless (defined $value) {
119 0         0 $state->_error("$variable expects an argument");
120 0         0 $warnings++;
121 0 0       0 last PARAM if $pedantic;
122 0         0 next;
123             }
124             }
125             # default an undefined value to 1 if ARGCOUNT_NONE
126             else {
127 2 50       40 $value = 1 unless defined $value;
128             }
129              
130             # set the variable, noting any error
131 6 50       69 unless ($state->set($variable, $value)) {
132 0         0 $warnings++;
133 0 0       0 last PARAM if $pedantic;
134             }
135                 }
136              
137             # restore original error handler
138 2         25     $state->_ehandler($errhandler);
139              
140             # return $warnings => 0, $success => 1
141 2 50       29     return $warnings ? 0 : 1;
142             }
143              
144              
145              
146             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
147             # The following sub-routine was lifted from Lincoln Stein's CGI.pm
148             # module, version 2.36. Name has been prefixed by a '_'.
149              
150             # unescape URL-encoded data
151             sub _unescape {
152 11     11   96     my($todecode) = @_;
153 11         135     $todecode =~ tr/+/ /; # pluses become spaces
154 11         93     $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
  0         0  
155 11         195     return $todecode;
156             }
157              
158             #
159             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
160              
161              
162              
163              
164             1;
165              
166             __END__
167            
168             =head1 NAME
169            
170             AppConfig::CGI - Perl5 module for processing CGI script parameters.
171            
172             =head1 SYNOPSIS
173            
174             use AppConfig::CGI;
175            
176             my $state = AppConfig::State->new(\%cfg);
177             my $cgi = AppConfig::CGI->new($state);
178            
179             $cgi->parse($cgi_query);
180             $cgi->parse(); # looks for CGI query in environment
181            
182             =head1 OVERVIEW
183            
184             AppConfig::CGI is a Perl5 module which implements a CGI interface to
185             AppConfig. It examines the QUERY_STRING environment variable, or a string
186             passed explicitly by parameter, which represents the additional parameters
187             passed to a CGI query. This is then used to update variable values in an
188             AppConfig::State object accordingly.
189            
190             AppConfig::CGI is distributed as part of the AppConfig bundle.
191            
192             =head1 DESCRIPTION
193            
194             =head2 USING THE AppConfig::CGI MODULE
195            
196             To import and use the AppConfig::CGI module the following line should appear
197             in your Perl script:
198            
199             use AppConfig::CGI;
200            
201             AppConfig::CGI is used automatically if you use the AppConfig module
202             and create an AppConfig::CGI object through the cgi() method.
203             AppConfig::CGI is implemented using object-oriented methods. A new
204             AppConfig::CGI object is created and initialised using the new()
205             method. This returns a reference to a new AppConfig::CGI object. A
206             reference to an AppConfig::State object should be passed in as the
207             first parameter:
208            
209             my $state = AppConfig::State->new();
210             my $cgi = AppConfig::CGI->new($state);
211            
212             This will create and return a reference to a new AppConfig::CGI object.
213            
214             =head2 PARSING CGI QUERIES
215            
216             The C<parse()> method is used to parse a CGI query which can be specified
217             explicitly, or is automatically extracted from the "QUERY_STRING" CGI
218             environment variable. This currently limits the module to only supporting
219             the GET method.
220            
221             See AppConfig for information about using the AppConfig::CGI
222             module via the cgi() method.
223            
224             =head1 AUTHOR
225            
226             Andy Wardley, C<E<lt>abw@wardley.org<gt>>
227            
228             =head1 REVISION
229            
230             $Revision: 1.60 $
231            
232             =head1 COPYRIGHT
233            
234             Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
235            
236             Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
237            
238             This module is free software; you can redistribute it and/or modify it
239             under the same terms as Perl itself.
240            
241             =head1 SEE ALSO
242            
243             AppConfig, AppConfig::State
244            
245             =cut
246            
247