234 lines
6.8 KiB
Perl
234 lines
6.8 KiB
Perl
#============================================================================
|
|
#
|
|
# AppConfig::CGI.pm
|
|
#
|
|
# Perl5 module to provide a CGI interface to AppConfig. Internal variables
|
|
# may be set through the CGI "arguments" appended to a URL.
|
|
#
|
|
# Written by Andy Wardley <abw@wardley.org>
|
|
#
|
|
# Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
|
|
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
|
|
#
|
|
#============================================================================
|
|
|
|
package AppConfig::CGI;
|
|
use 5.006;
|
|
use strict;
|
|
use warnings;
|
|
use AppConfig::State;
|
|
our $VERSION = '1.71';
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# new($state, $query)
|
|
#
|
|
# Module constructor. The first, mandatory parameter should be a
|
|
# reference to an AppConfig::State object to which all actions should
|
|
# be applied. The second parameter may be a string containing a CGI
|
|
# QUERY_STRING which is then passed to parse() to process. If no second
|
|
# parameter is specifiied then the parse() process is skipped.
|
|
#
|
|
# Returns a reference to a newly created AppConfig::CGI object.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $state = shift;
|
|
my $self = {
|
|
STATE => $state, # AppConfig::State ref
|
|
DEBUG => $state->_debug(), # store local copy of debug
|
|
PEDANTIC => $state->_pedantic, # and pedantic flags
|
|
};
|
|
bless $self, $class;
|
|
|
|
# call parse(@_) to parse any arg list passed
|
|
$self->parse(@_)
|
|
if @_;
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# parse($query)
|
|
#
|
|
# Method used to parse a CGI QUERY_STRING and set internal variable
|
|
# values accordingly. If a query is not passed as the first parameter,
|
|
# then _get_cgi_query() is called to try to determine the query by
|
|
# examing the environment as per CGI protocol.
|
|
#
|
|
# Returns 0 if one or more errors or warnings were raised or 1 if the
|
|
# string parsed successfully.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub parse {
|
|
my $self = shift;
|
|
my $query = shift;
|
|
my $warnings = 0;
|
|
my ($variable, $value, $nargs);
|
|
|
|
|
|
# take a local copy of the state to avoid much hash dereferencing
|
|
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
|
|
|
|
# get the cgi query if not defined
|
|
$query = $ENV{ QUERY_STRING }
|
|
unless defined $query;
|
|
|
|
# no query to process
|
|
return 1 unless defined $query;
|
|
|
|
# we want to install a custom error handler into the AppConfig::State
|
|
# which appends filename and line info to error messages and then
|
|
# calls the previous handler; we start by taking a copy of the
|
|
# current handler..
|
|
my $errhandler = $state->_ehandler();
|
|
|
|
# install a closure as a new error handler
|
|
$state->_ehandler(
|
|
sub {
|
|
# modify the error message
|
|
my $format = shift;
|
|
$format =~ s/</</g;
|
|
$format =~ s/>/>/g;
|
|
$format = "<p>\n<b>[ AppConfig::CGI error: </b>$format<b> ] </b>\n<p>\n";
|
|
# send error to stdout for delivery to web client
|
|
printf($format, @_);
|
|
}
|
|
);
|
|
|
|
|
|
PARAM: foreach (split('&', $query)) {
|
|
|
|
# extract parameter and value from query token
|
|
($variable, $value) = map { _unescape($_) } split('=');
|
|
|
|
# check an argument was provided if one was expected
|
|
if ($nargs = $state->_argcount($variable)) {
|
|
unless (defined $value) {
|
|
$state->_error("$variable expects an argument");
|
|
$warnings++;
|
|
last PARAM if $pedantic;
|
|
next;
|
|
}
|
|
}
|
|
# default an undefined value to 1 if ARGCOUNT_NONE
|
|
else {
|
|
$value = 1 unless defined $value;
|
|
}
|
|
|
|
# set the variable, noting any error
|
|
unless ($state->set($variable, $value)) {
|
|
$warnings++;
|
|
last PARAM if $pedantic;
|
|
}
|
|
}
|
|
|
|
# restore original error handler
|
|
$state->_ehandler($errhandler);
|
|
|
|
# return $warnings => 0, $success => 1
|
|
return $warnings ? 0 : 1;
|
|
}
|
|
|
|
|
|
|
|
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
# The following sub-routine was lifted from Lincoln Stein's CGI.pm
|
|
# module, version 2.36. Name has been prefixed by a '_'.
|
|
|
|
# unescape URL-encoded data
|
|
sub _unescape {
|
|
my($todecode) = @_;
|
|
$todecode =~ tr/+/ /; # pluses become spaces
|
|
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
|
|
return $todecode;
|
|
}
|
|
|
|
#
|
|
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
|
|
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
AppConfig::CGI - Perl5 module for processing CGI script parameters.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use AppConfig::CGI;
|
|
|
|
my $state = AppConfig::State->new(\%cfg);
|
|
my $cgi = AppConfig::CGI->new($state);
|
|
|
|
$cgi->parse($cgi_query);
|
|
$cgi->parse(); # looks for CGI query in environment
|
|
|
|
=head1 OVERVIEW
|
|
|
|
AppConfig::CGI is a Perl5 module which implements a CGI interface to
|
|
AppConfig. It examines the QUERY_STRING environment variable, or a string
|
|
passed explicitly by parameter, which represents the additional parameters
|
|
passed to a CGI query. This is then used to update variable values in an
|
|
AppConfig::State object accordingly.
|
|
|
|
AppConfig::CGI is distributed as part of the AppConfig bundle.
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
=head2 USING THE AppConfig::CGI MODULE
|
|
|
|
To import and use the AppConfig::CGI module the following line should appear
|
|
in your Perl script:
|
|
|
|
use AppConfig::CGI;
|
|
|
|
AppConfig::CGI is used automatically if you use the AppConfig module
|
|
and create an AppConfig::CGI object through the cgi() method.
|
|
AppConfig::CGI is implemented using object-oriented methods. A new
|
|
AppConfig::CGI object is created and initialised using the new()
|
|
method. This returns a reference to a new AppConfig::CGI object. A
|
|
reference to an AppConfig::State object should be passed in as the
|
|
first parameter:
|
|
|
|
my $state = AppConfig::State->new();
|
|
my $cgi = AppConfig::CGI->new($state);
|
|
|
|
This will create and return a reference to a new AppConfig::CGI object.
|
|
|
|
=head2 PARSING CGI QUERIES
|
|
|
|
The C<parse()> method is used to parse a CGI query which can be specified
|
|
explicitly, or is automatically extracted from the "QUERY_STRING" CGI
|
|
environment variable. This currently limits the module to only supporting
|
|
the GET method.
|
|
|
|
See AppConfig for information about using the AppConfig::CGI
|
|
module via the cgi() method.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Andy Wardley, C<E<lt>abw@wardley.org<gt>>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
|
|
|
|
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
|
|
|
|
This module is free software; you can redistribute it and/or modify it
|
|
under the same terms as Perl itself.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
AppConfig, AppConfig::State
|
|
|
|
=cut
|
|
|