Initial Commit

database/perl/vendor/lib/AppConfig/CGI.pm

@@ -0,0 +1,233 @@
+#============================================================================
+#
+# 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/</&lt;/g;
+            $format =~ s/>/&gt;/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
+