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