local-lib5/lib/perl5/AppConfig/CGI.pm

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