KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

238
database/perl/vendor/lib/AppConfig/Args.pm vendored Normal file
View File

@@ -0,0 +1,238 @@
#============================================================================
#
# AppConfig::Args.pm
#
# Perl5 module to read command line argument and update the variable
# values in an AppConfig::State object accordingly.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#============================================================================
package AppConfig::Args;
use 5.006;
use strict;
use warnings;
use AppConfig::State;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, \@args)
#
# 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 reference to a list of
# command line arguments. This list reference is passed to args() for
# processing.
#
# Returns a reference to a newly created AppConfig::Args 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(shift)
if @_;
return $self;
}
#------------------------------------------------------------------------
# parse(\@args)
#
# Examines the argument list and updates the contents of the
# AppConfig::State referenced by $self->{ STATE } accordingly. If
# no argument list is provided then the method defaults to examining
# @ARGV. The method reports any warning conditions (such as undefined
# variables) by calling $self->{ STATE }->_error() and then continues to
# examine the rest of the list. If the PEDANTIC option is set in the
# AppConfig::State object, this behaviour is overridden and the method
# returns 0 immediately on any parsing error.
#
# Returns 1 on success or 0 if one or more warnings were raised.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $argv = shift || \@ARGV;
my $warnings = 0;
my ($arg, $nargs, $variable, $value);
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# loop around arguments
ARG: while (@$argv && $argv->[0] =~ /^-/) {
$arg = shift(@$argv);
# '--' indicates the end of the options
last if $arg eq '--';
# strip leading '-';
($variable = $arg) =~ s/^-(-)?//;
# test for '--' prefix and push back any '=value' item
if (defined $1) {
($variable, $value) = split(/=/, $variable);
unshift(@$argv, $value) if defined $value;
}
# check the variable exists
if ($state->_exists($variable)) {
# see if it expects any mandatory arguments
$nargs = $state->_argcount($variable);
if ($nargs) {
# check there's another arg and it's not another '-opt'
if(defined($argv->[0])) {
$value = shift(@$argv);
}
else {
$state->_error("$arg expects an argument");
$warnings++;
last ARG if $pedantic;
next;
}
}
else {
# set a value of 1 if option doesn't expect an argument
$value = 1;
}
# set the variable with the new value
$state->set($variable, $value);
}
else {
$state->_error("$arg: invalid option");
$warnings++;
last ARG if $pedantic;
}
}
# return status
return $warnings ? 0 : 1;
}
1;
__END__
=head1 NAME
AppConfig::Args - Perl5 module for reading command line arguments.
=head1 SYNOPSIS
use AppConfig::Args;
my $state = AppConfig::State->new(\%cfg);
my $cfgargs = AppConfig::Args->new($state);
$cfgargs->parse(\@args); # read args
=head1 OVERVIEW
AppConfig::Args is a Perl5 module which reads command line arguments and
uses the options therein to update variable values in an AppConfig::State
object.
AppConfig::File is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::Args MODULE
To import and use the AppConfig::Args module the following line should appear
in your Perl script:
use AppConfig::Args;
AppConfig::Args is used automatically if you use the AppConfig module
and create an AppConfig::Args object through the parse() method.
AppConfig::File is implemented using object-oriented methods. A new
AppConfig::Args object is created and initialised using the new() method.
This returns a reference to a new AppConfig::File object. A reference to
an AppConfig::State object should be passed in as the first parameter:
my $state = AppConfig::State->new();
my $cfgargs = AppConfig::Args->new($state);
This will create and return a reference to a new AppConfig::Args object.
=head2 PARSING COMMAND LINE ARGUMENTS
The C<parse()> method is used to read a list of command line arguments and
update the STATE accordingly. A reference to the list of arguments should
be passed in.
$cfgargs->parse(\@ARGV);
If the method is called without a reference to an argument list then it
will examine and manipulate @ARGV.
If the PEDANTIC option is turned off in the AppConfig::State object, any
parsing errors (invalid variables, unvalidated values, etc) will generate
warnings, but not cause the method to return. Having processed all
arguments, the method will return 1 if processed without warning or 0 if
one or more warnings were raised. When the PEDANTIC option is turned on,
the method generates a warning and immediately returns a value of 0 as soon
as it encounters any parsing error.
The method continues parsing arguments until it detects the first one that
does not start with a leading dash, '-'. Arguments that constitute values
for other options are not examined in this way.
=head1 FUTURE DEVELOPMENT
This module was developed to provide backwards compatibility (to some
degree) with the preceeding App::Config module. The argument parsing
it provides is basic but offers a quick and efficient solution for those
times when simple option handling is all that is required.
If you require more flexibility in parsing command line arguments, then
you should consider using the AppConfig::Getopt module. This is loaded
and used automatically by calling the AppConfig getopt() method.
The AppConfig::Getopt module provides considerably extended functionality
over the AppConfig::Args module by delegating out the task of argument
parsing to Johan Vromans' Getopt::Long module. For advanced command-line
parsing, this module (either Getopt::Long by itself, or in conjunction with
AppConfig::Getopt) is highly recommended.
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<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, AppConfig::Getopt, Getopt::Long
=cut

233
database/perl/vendor/lib/AppConfig/CGI.pm vendored Normal file
View File

@@ -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

710
database/perl/vendor/lib/AppConfig/File.pm vendored Normal file
View File

@@ -0,0 +1,710 @@
#============================================================================
#
# AppConfig::File.pm
#
# Perl5 module to read configuration files and use the contents therein
# to update variable values in an AppConfig::State object.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
#============================================================================
package AppConfig::File;
use 5.006;
use strict;
use warnings;
use AppConfig;
use AppConfig::State;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, $file, [$file, ...])
#
# Module constructor. The first, mandatory parameter should be a
# reference to an AppConfig::State object to which all actions should
# be applied. The remaining parameters are assumed to be file names or
# file handles for reading and are passed to parse().
#
# Returns a reference to a newly created AppConfig::File 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 files specified as further params
$self->parse(@_) if @_;
return $self;
}
#------------------------------------------------------------------------
# parse($file, [file, ...])
#
# Reads and parses a config file, updating the contents of the
# AppConfig::State referenced by $self->{ STATE } according to the
# contents of the file. Multiple files may be specified and are
# examined in turn. The method reports any error condition via
# $self->{ STATE }->_error() and immediately returns undef if it
# encounters a system error (i.e. cannot open one of the files.
# Parsing errors such as unknown variables or unvalidated values will
# also cause warnings to be raised vi the same _error(), but parsing
# continues to the end of the current file and through any subsequent
# files. If the PEDANTIC option is set in the $self->{ STATE } object,
# the behaviour is overridden and the method returns 0 immediately on
# any system or parsing error.
#
# The EXPAND option for each variable determines how the variable
# value should be expanded.
#
# Returns undef on system error, 0 if all files were parsed but generated
# one or more warnings, 1 if all files parsed without warnings.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $warnings = 0;
my $prefix; # [block] defines $prefix
my $file;
my $flag;
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# 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();
# ...and if it doesn't exist, we craft a default handler
$errhandler = sub { warn(sprintf(shift, @_), "\n") }
unless defined $errhandler;
# install a closure as a new error handler
$state->_ehandler(
sub {
# modify the error message
my $format = shift;
$format .= ref $file
? " at line $."
: " at $file line $.";
# chain call to prevous handler
&$errhandler($format, @_);
}
);
# trawl through all files passed as params
FILE: while ($file = shift) {
# local/lexical vars ensure opened files get closed
my $handle;
local *FH;
# if the file is a reference, we assume it's a file handle, if
# not, we assume it's a filename and attempt to open it
$handle = $file;
if (ref($file)) {
$handle = $file;
# DEBUG
print STDERR "reading from file handle: $file\n" if $debug;
}
else {
# open and read config file
open(FH, $file) or do {
# restore original error handler and report error
$state->_ehandler($errhandler);
$state->_error("$file: $!");
return undef;
};
$handle = \*FH;
# DEBUG
print STDERR "reading file: $file\n" if $debug;
}
# initialise $prefix to nothing (no [block])
$prefix = '';
local $_;
while (<$handle>) {
chomp;
# Throw away everything from an unescaped # to EOL
s/(^|\s+)#.*/$1/;
# add next line if there is one and this is a continuation
if (s/\\$// && !eof($handle)) {
$_ .= <$handle>;
redo;
}
# Convert \# -> #
s/\\#/#/g;
# ignore blank lines
next if /^\s*$/;
# strip leading and trailing whitespace
s/^\s+//;
s/\s+$//;
# look for a [block] to set $prefix
if (/^\[([^\]]+)\]$/) {
$prefix = $1;
print STDERR "Entering [$prefix] block\n" if $debug;
next;
}
# split line up by whitespace (\s+) or "equals" (\s*=\s*)
if (/^([^\s=]+)(?:(?:(?:\s*=\s*)|\s+)(.*))?/) {
my ($variable, $value) = ($1, $2);
if (defined $value) {
# here document
if ($value =~ /^([^\s=]+\s*=)?\s*<<(['"]?)(\S+)\2$/) { # '<<XX' or 'hashkey =<<XX'
my $boundary = "$3\n";
$value = defined($1) ? $1 : '';
while (<$handle>) {
last if $_ eq $boundary;
$value .= $_;
};
$value =~ s/[\r\n]$//;
} else {
# strip any quoting from the variable value
$value =~ s/^(['"])(.*)\1$/$2/;
};
};
# strip any leading '+/-' from the variable
$variable =~ s/^([\-+]?)//;
$flag = $1;
# $variable gets any $prefix
$variable = $prefix . '_' . $variable
if length $prefix;
# if the variable doesn't exist, we call set() to give
# AppConfig::State a chance to auto-create it
unless ($state->_exists($variable)
|| $state->set($variable, 1)) {
$warnings++;
last FILE if $pedantic;
next;
}
my $nargs = $state->_argcount($variable);
# variables prefixed '-' are reset to their default values
if ($flag eq '-') {
$state->_default($variable);
next;
}
# those prefixed '+' get set to 1
elsif ($flag eq '+') {
$value = 1 unless defined $value;
}
# determine if any extra arguments were expected
if ($nargs) {
if (defined $value && length $value) {
# expand any embedded variables, ~uids or
# environment variables, testing the return value
# for errors; we pass in any variable-specific
# EXPAND value
unless ($self->_expand(\$value,
$state->_expand($variable), $prefix)) {
print STDERR "expansion of [$value] failed\n"
if $debug;
$warnings++;
last FILE if $pedantic;
}
}
else {
$state->_error("$variable expects an argument");
$warnings++;
last FILE if $pedantic;
next;
}
}
# $nargs = 0
else {
# default value to 1 unless it is explicitly defined
# as '0' or "off"
if (defined $value) {
# "off" => 0
$value = 0 if $value =~ /off/i;
# any value => 1
$value = 1 if $value;
}
else {
# assume 1 unless explicitly defined off/0
$value = 1;
}
print STDERR "$variable => $value (no expansion)\n"
if $debug;
}
# set the variable, noting any failure from set()
unless ($state->set($variable, $value)) {
$warnings++;
last FILE if $pedantic;
}
}
else {
$state->_error("parse error");
$warnings++;
}
}
}
# restore original error handler
$state->_ehandler($errhandler);
# return $warnings => 0, $success => 1
return $warnings ? 0 : 1;
}
#========================================================================
# ----- PRIVATE METHODS -----
#========================================================================
#------------------------------------------------------------------------
# _expand(\$value, $expand, $prefix)
#
# The variable value string, referenced by $value, is examined and any
# embedded variables, environment variables or tilde globs (home
# directories) are replaced with their respective values, depending on
# the value of the second parameter, $expand. The third paramter may
# specify the name of the current [block] in which the parser is
# parsing. This prefix is prepended to any embedded variable name that
# can't otherwise be resolved. This allows the following to work:
#
# [define]
# home = /home/abw
# html = $define_home/public_html
# html = $home/public_html # same as above, 'define' is prefix
#
# Modifications are made directly into the variable referenced by $value.
# The method returns 1 on success or 0 if any warnings (undefined
# variables) were encountered.
#------------------------------------------------------------------------
sub _expand {
my ($self, $value, $expand, $prefix) = @_;
my $warnings = 0;
my ($sys, $var, $val);
# ensure prefix contains something (nothing!) valid for length()
$prefix = "" unless defined $prefix;
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# bail out if there's nothing to do
return 1 unless $expand && defined($$value);
# create an AppConfig::Sys instance, or re-use a previous one,
# to handle platform dependant functions: getpwnam(), getpwuid()
unless ($sys = $self->{ SYS }) {
require AppConfig::Sys;
$sys = $self->{ SYS } = AppConfig::Sys->new();
}
print STDERR "Expansion of [$$value] " if $debug;
EXPAND: {
#
# EXPAND_VAR
# expand $(var) and $var as AppConfig::State variables
#
if ($expand & AppConfig::EXPAND_VAR) {
$$value =~ s{
(?<!\\)\$ (?: \((\w+)\) | (\w+) ) # $2 => $(var) | $3 => $var
} {
# embedded variable name will be one of $2 or $3
$var = defined $1 ? $1 : $2;
# expand the variable if defined
if ($state->_exists($var)) {
$val = $state->get($var);
}
elsif (length $prefix
&& $state->_exists($prefix . '_' . $var)) {
print STDERR "(\$$var => \$${prefix}_$var) "
if $debug;
$var = $prefix . '_' . $var;
$val = $state->get($var);
}
else {
# raise a warning if EXPAND_WARN set
if ($expand & AppConfig::EXPAND_WARN) {
$state->_error("$var: no such variable");
$warnings++;
}
# replace variable with nothing
$val = '';
}
# $val gets substituted back into the $value string
$val;
}gex;
$$value =~ s/\\\$/\$/g;
# bail out now if we need to
last EXPAND if $warnings && $pedantic;
}
#
# EXPAND_UID
# expand ~uid as home directory (for $< if uid not specified)
#
if ($expand & AppConfig::EXPAND_UID) {
$$value =~ s{
~(\w+)? # $1 => username (optional)
} {
$val = undef;
# embedded user name may be in $1
if (defined ($var = $1)) {
# try and get user's home directory
if ($sys->can_getpwnam()) {
$val = ($sys->getpwnam($var))[7];
}
} else {
# determine home directory
$val = $ENV{ HOME };
}
# catch-all for undefined $dir
unless (defined $val) {
# raise a warning if EXPAND_WARN set
if ($expand & AppConfig::EXPAND_WARN) {
$state->_error("cannot determine home directory%s",
defined $var ? " for $var" : "");
$warnings++;
}
# replace variable with nothing
$val = '';
}
# $val gets substituted back into the $value string
$val;
}gex;
# bail out now if we need to
last EXPAND if $warnings && $pedantic;
}
#
# EXPAND_ENV
# expand ${VAR} as environment variables
#
if ($expand & AppConfig::EXPAND_ENV) {
$$value =~ s{
( \$ \{ (\w+) \} )
} {
$var = $2;
# expand the variable if defined
if (exists $ENV{ $var }) {
$val = $ENV{ $var };
} elsif ( $var eq 'HOME' ) {
# In the special case of HOME, if not set
# use the internal version
$val = $self->{ HOME };
} else {
# raise a warning if EXPAND_WARN set
if ($expand & AppConfig::EXPAND_WARN) {
$state->_error("$var: no such environment variable");
$warnings++;
}
# replace variable with nothing
$val = '';
}
# $val gets substituted back into the $value string
$val;
}gex;
# bail out now if we need to
last EXPAND if $warnings && $pedantic;
}
}
print STDERR "=> [$$value] (EXPAND = $expand)\n" if $debug;
# return status
return $warnings ? 0 : 1;
}
#------------------------------------------------------------------------
# _dump()
#
# Dumps the contents of the Config object.
#------------------------------------------------------------------------
sub _dump {
my $self = shift;
foreach my $key (keys %$self) {
printf("%-10s => %s\n", $key,
defined($self->{ $key }) ? $self->{ $key } : "<undef>");
}
}
1;
__END__
=head1 NAME
AppConfig::File - Perl5 module for reading configuration files.
=head1 SYNOPSIS
use AppConfig::File;
my $state = AppConfig::State->new(\%cfg1);
my $cfgfile = AppConfig::File->new($state, $file);
$cfgfile->parse($file); # read config file
=head1 OVERVIEW
AppConfig::File is a Perl5 module which reads configuration files and use
the contents therein to update variable values in an AppConfig::State
object.
AppConfig::File is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::File MODULE
To import and use the AppConfig::File module the following line should appear
in your Perl script:
use AppConfig::File;
AppConfig::File is used automatically if you use the AppConfig module
and create an AppConfig::File object through the file() method.
AppConfig::File is implemented using object-oriented methods. A new
AppConfig::File object is created and initialised using the
AppConfig::File->new() method. This returns a reference to a new
AppConfig::File object. A reference to an AppConfig::State object
should be passed in as the first parameter:
my $state = AppConfig::State->new();
my $cfgfile = AppConfig::File->new($state);
This will create and return a reference to a new AppConfig::File object.
=head2 READING CONFIGURATION FILES
The C<parse()> method is used to read a configuration file and have the
contents update the STATE accordingly.
$cfgfile->parse($file);
Multiple files maye be specified and will be read in turn.
$cfgfile->parse($file1, $file2, $file3);
The method will return an undef value if it encounters any errors opening
the files. It will return immediately without processing any further files.
By default, the PEDANTIC option in the AppConfig::State object,
$self->{ STATE }, is turned off and any parsing errors (invalid variables,
unvalidated values, etc) will generated warnings, but not cause the method
to return. Having processed all files, the method will return 1 if all
files were processed without warning or 0 if one or more warnings were
raised. When the PEDANTIC option is turned on, the method generates a
warning and immediately returns a value of 0 as soon as it encounters any
parsing error.
Variables values in the configuration files may be expanded depending on
the value of their EXPAND option, as determined from the App::State object.
See L<AppConfig::State> for more information on variable expansion.
=head2 CONFIGURATION FILE FORMAT
A configuration file may contain blank lines and comments which are
ignored. Comments begin with a '#' as the first character on a line
or following one or more whitespace tokens, and continue to the end of
the line.
# this is a comment
foo = bar # so is this
url = index.html#hello # this too, but not the '#welcome'
Notice how the '#welcome' part of the URL is not treated as a comment
because a whitespace character doesn't precede it.
Long lines can be continued onto the next line by ending the first
line with a '\'.
callsign = alpha bravo camel delta echo foxtrot golf hipowls \
india juliet kilo llama mike november oscar papa \
quebec romeo sierra tango umbrella victor whiskey \
x-ray yankee zebra
Variables that are simple flags and do not expect an argument (ARGCOUNT =
ARGCOUNT_NONE) can be specified without any value. They will be set with
the value 1, with any value explicitly specified (except "0" and "off")
being ignored. The variable may also be specified with a "no" prefix to
implicitly set the variable to 0.
verbose # on (1)
verbose = 1 # on (1)
verbose = 0 # off (0)
verbose off # off (0)
verbose on # on (1)
verbose mumble # on (1)
noverbose # off (0)
Variables that expect an argument (ARGCOUNT = ARGCOUNT_ONE) will be set to
whatever follows the variable name, up to the end of the current line. An
equals sign may be inserted between the variable and value for clarity.
room = /home/kitchen
room /home/bedroom
Each subsequent re-definition of the variable value overwrites the previous
value.
print $config->room(); # prints "/home/bedroom"
Variables may be defined to accept multiple values (ARGCOUNT = ARGCOUNT_LIST).
Each subsequent definition of the variable adds the value to the list of
previously set values for the variable.
drink = coffee
drink = tea
A reference to a list of values is returned when the variable is requested.
my $beverages = $config->drinks();
print join(", ", @$beverages); # prints "coffee, tea"
Variables may also be defined as hash lists (ARGCOUNT = ARGCOUNT_HASH).
Each subsequent definition creates a new key and value in the hash array.
alias l="ls -CF"
alias h="history"
A reference to the hash is returned when the variable is requested.
my $aliases = $config->alias();
foreach my $k (keys %$aliases) {
print "$k => $aliases->{ $k }\n";
}
A large chunk of text can be defined using Perl's "heredoc" quoting
style.
scalar = <<BOUNDARY_STRING
line 1
line 2: Space/linebreaks within a HERE document are kept.
line 3: The last linebreak (\n) is stripped.
BOUNDARY_STRING
hash key1 = <<'FOO'
* Quotes (['"]) around the boundary string are simply ignored.
* Whether the variables in HERE document are expanded depends on
the EXPAND option of the variable or global setting.
FOO
hash = key2 = <<"_bar_"
Text within HERE document are kept as is.
# comments are treated as a normal text.
The same applies to line continuation. \
_bar_
Note that you cannot use HERE document as a key in a hash or a name
of a variable.
The '-' prefix can be used to reset a variable to its default value and
the '+' prefix can be used to set it to 1
-verbose
+debug
Variable, environment variable and tilde (home directory) expansions
Variable values may contain references to other AppConfig variables,
environment variables and/or users' home directories. These will be
expanded depending on the EXPAND value for each variable or the GLOBAL
EXPAND value.
Three different expansion types may be applied:
bin = ~/bin # expand '~' to home dir if EXPAND_UID
tmp = ~abw/tmp # as above, but home dir for user 'abw'
perl = $bin/perl # expand value of 'bin' variable if EXPAND_VAR
ripl = $(bin)/ripl # as above with explicit parens
home = ${HOME} # expand HOME environment var if EXPAND_ENV
See L<AppConfig::State> for more information on expanding variable values.
The configuration files may have variables arranged in blocks. A block
header, consisting of the block name in square brackets, introduces a
configuration block. The block name and an underscore are then prefixed
to the names of all variables subsequently referenced in that block. The
block continues until the next block definition or to the end of the current
file.
[block1]
foo = 10 # block1_foo = 10
[block2]
foo = 20 # block2_foo = 20
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
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

271
database/perl/vendor/lib/AppConfig/Getopt.pm vendored Normal file
View File

@@ -0,0 +1,271 @@
#============================================================================
#
# AppConfig::Getopt.pm
#
# Perl5 module to interface AppConfig::* to Johan Vromans' Getopt::Long
# module. Getopt::Long implements the POSIX standard for command line
# options, with GNU extensions, and also traditional one-letter options.
# AppConfig::Getopt constructs the necessary Getopt:::Long configuration
# from the internal AppConfig::State and delegates the parsing of command
# line arguments to it. Internal variable values are updated by callback
# from GetOptions().
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
#============================================================================
package AppConfig::Getopt;
use 5.006;
use strict;
use warnings;
use AppConfig::State;
use Getopt::Long 2.17;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, \@args)
#
# 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 reference to a list of
# command line arguments. This list reference is passed to parse() for
# processing.
#
# Returns a reference to a newly created AppConfig::Getopt object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $state = shift;
my $self = {
STATE => $state,
};
bless $self, $class;
# call parse() to parse any arg list passed
$self->parse(@_)
if @_;
return $self;
}
#------------------------------------------------------------------------
# parse(@$config, \@args)
#
# Constructs the appropriate configuration information and then delegates
# the task of processing command line options to Getopt::Long.
#
# Returns 1 on success or 0 if one or more warnings were raised.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $state = $self->{ STATE };
my (@config, $args, $getopt);
local $" = ', ';
# we trap $SIG{__WARN__} errors and patch them into AppConfig::State
local $SIG{__WARN__} = sub {
my $msg = shift;
# AppConfig::State doesn't expect CR terminated error messages
# and it uses printf, so we protect any embedded '%' chars
chomp($msg);
$state->_error("%s", $msg);
};
# slurp all config items into @config
push(@config, shift) while defined $_[0] && ! ref($_[0]);
# add debug status if appropriate (hmm...can't decide about this)
# push(@config, 'debug') if $state->_debug();
# next parameter may be a reference to a list of args
$args = shift;
# copy any args explicitly specified into @ARGV
@ARGV = @$args if defined $args;
# we enclose in an eval block because constructor may die()
eval {
# configure Getopt::Long
Getopt::Long::Configure(@config);
# construct options list from AppConfig::State variables
my @opts = $self->{ STATE }->_getopt_state();
# DEBUG
if ($state->_debug()) {
print STDERR "Calling GetOptions(@opts)\n";
print STDERR "\@ARGV = (@ARGV)\n";
};
# call GetOptions() with specifications constructed from the state
$getopt = GetOptions(@opts);
};
if ($@) {
chomp($@);
$state->_error("%s", $@);
return 0;
}
# udpdate any args reference passed to include only that which is left
# in @ARGV
@$args = @ARGV if defined $args;
return $getopt;
}
#========================================================================
# AppConfig::State
#========================================================================
package AppConfig::State;
#------------------------------------------------------------------------
# _getopt_state()
#
# Constructs option specs in the Getopt::Long format for each variable
# definition.
#
# Returns a list of specification strings.
#------------------------------------------------------------------------
sub _getopt_state {
my $self = shift;
my ($var, $spec, $args, $argcount, @specs);
my $linkage = sub { $self->set(@_) };
foreach $var (keys %{ $self->{ VARIABLE } }) {
$spec = join('|', $var, @{ $self->{ ALIASES }->{ $var } || [ ] });
# an ARGS value is used, if specified
unless (defined ($args = $self->{ ARGS }->{ $var })) {
# otherwise, construct a basic one from ARGCOUNT
ARGCOUNT: {
last ARGCOUNT unless
defined ($argcount = $self->{ ARGCOUNT }->{ $var });
$args = "=s", last ARGCOUNT if $argcount eq ARGCOUNT_ONE;
$args = "=s@", last ARGCOUNT if $argcount eq ARGCOUNT_LIST;
$args = "=s%", last ARGCOUNT if $argcount eq ARGCOUNT_HASH;
$args = "!";
}
}
$spec .= $args if defined $args;
push(@specs, $spec, $linkage);
}
return @specs;
}
1;
__END__
=head1 NAME
AppConfig::Getopt - Perl5 module for processing command line arguments via delegation to Getopt::Long.
=head1 SYNOPSIS
use AppConfig::Getopt;
my $state = AppConfig::State->new(\%cfg);
my $getopt = AppConfig::Getopt->new($state);
$getopt->parse(\@args); # read args
=head1 OVERVIEW
AppConfig::Getopt is a Perl5 module which delegates to Johan Vroman's
Getopt::Long module to parse command line arguments and update values
in an AppConfig::State object accordingly.
AppConfig::Getopt is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::Getopt MODULE
To import and use the AppConfig::Getopt module the following line should appear
in your Perl script:
use AppConfig::Getopt;
AppConfig::Getopt is used automatically if you use the AppConfig module
and create an AppConfig::Getopt object through the getopt() method.
AppConfig::Getopt is implemented using object-oriented methods. A new
AppConfig::Getopt object is created and initialised using the new() method.
This returns a reference to a new AppConfig::Getopt object. A reference to
an AppConfig::State object should be passed in as the first parameter:
my $state = AppConfig::State->new();
my $getopt = AppConfig::Getopt->new($state);
This will create and return a reference to a new AppConfig::Getopt object.
=head2 PARSING COMMAND LINE ARGUMENTS
The C<parse()> method is used to read a list of command line arguments and
update the state accordingly.
The first (non-list reference) parameters may contain a number of
configuration strings to pass to Getopt::Long::Configure. A reference
to a list of arguments may additionally be passed or @ARGV is used by
default.
$getopt->parse(); # uses @ARGV
$getopt->parse(\@myargs);
$getopt->parse(qw(auto_abbrev debug)); # uses @ARGV
$getopt->parse(qw(debug), \@myargs);
See Getopt::Long for details of the configuartion options available.
A Getopt::Long specification string is constructed for each variable
defined in the AppConfig::State. This consists of the name, any aliases
and the ARGS value for the variable.
These specification string are then passed to Getopt::Long, the arguments
are parsed and the values in the AppConfig::State updated.
See AppConfig for information about using the AppConfig::Getopt
module via the getopt() method.
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<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 ACKNOWLEDGMENTS
Many thanks are due to Johan Vromans for the Getopt::Long module. He was
kind enough to offer assistance and access to early releases of his code to
enable this module to be written.
=head1 SEE ALSO
AppConfig, AppConfig::State, AppConfig::Args, Getopt::Long
=cut

1430
database/perl/vendor/lib/AppConfig/State.pm vendored Normal file
View File

File diff suppressed because it is too large Load Diff

303
database/perl/vendor/lib/AppConfig/Sys.pm vendored Normal file
View File

@@ -0,0 +1,303 @@
#============================================================================
#
# AppConfig::Sys.pm
#
# Perl5 module providing platform-specific information and operations as
# required by other AppConfig::* modules.
#
# 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.
#
# $Id: Sys.pm,v 1.61 2004/02/04 10:11:23 abw Exp $
#
#============================================================================
package AppConfig::Sys;
use 5.006;
use strict;
use warnings;
use POSIX qw( getpwnam getpwuid );
our $VERSION = '1.71';
our ($AUTOLOAD, $OS, %CAN, %METHOD);
BEGIN {
# define the methods that may be available
if($^O =~ m/win32/i) {
$METHOD{ getpwuid } = sub {
return wantarray()
? ( (undef) x 7, getlogin() )
: getlogin();
};
$METHOD{ getpwnam } = sub {
die("Can't getpwnam on win32");
};
}
else
{
$METHOD{ getpwuid } = sub {
getpwuid( defined $_[0] ? shift : $< );
};
$METHOD{ getpwnam } = sub {
getpwnam( defined $_[0] ? shift : '' );
};
}
# try out each METHOD to see if it's supported on this platform;
# it's important we do this before defining AUTOLOAD which would
# otherwise catch the unresolved call
foreach my $method (keys %METHOD) {
eval { &{ $METHOD{ $method } }() };
$CAN{ $method } = ! $@;
}
}
#------------------------------------------------------------------------
# new($os)
#
# Module constructor. An optional operating system string may be passed
# to explicitly define the platform type.
#
# Returns a reference to a newly created AppConfig::Sys object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $self = {
METHOD => \%METHOD,
CAN => \%CAN,
};
bless $self, $class;
$self->_configure(@_);
return $self;
}
#------------------------------------------------------------------------
# AUTOLOAD
#
# Autoload function called whenever an unresolved object method is
# called. If the method name relates to a METHODS entry, then it is
# called iff the corresponding CAN_$method is set true. If the
# method name relates to a CAN_$method value then that is returned.
#------------------------------------------------------------------------
sub AUTOLOAD {
my $self = shift;
my $method;
# splat the leading package name
($method = $AUTOLOAD) =~ s/.*:://;
# ignore destructor
$method eq 'DESTROY' && return;
# can_method()
if ($method =~ s/^can_//i && exists $self->{ CAN }->{ $method }) {
return $self->{ CAN }->{ $method };
}
# method()
elsif (exists $self->{ METHOD }->{ $method }) {
if ($self->{ CAN }->{ $method }) {
return &{ $self->{ METHOD }->{ $method } }(@_);
}
else {
return undef;
}
}
# variable
elsif (exists $self->{ uc $method }) {
return $self->{ uc $method };
}
else {
warn("AppConfig::Sys->", $method, "(): no such method or variable\n");
}
return undef;
}
#------------------------------------------------------------------------
# _configure($os)
#
# Uses the first parameter, $os, the package variable $AppConfig::Sys::OS,
# the value of $^O, or as a last resort, the value of
# $Config::Config('osname') to determine the current operating
# system/platform. Sets internal variables accordingly.
#------------------------------------------------------------------------
sub _configure {
my $self = shift;
# operating system may be defined as a parameter or in $OS
my $os = shift || $OS;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The following was lifted (and adapated slightly) from Lincoln Stein's
# CGI.pm module, version 2.36...
#
# FIGURE OUT THE OS WE'RE RUNNING UNDER
# Some systems support the $^O variable. If not
# available then require() the Config library
unless ($os) {
unless ($os = $^O) {
require Config;
$os = $Config::Config{'osname'};
}
}
if ($os =~ /win32/i) {
$os = 'WINDOWS';
} elsif ($os =~ /vms/i) {
$os = 'VMS';
} elsif ($os =~ /mac/i) {
$os = 'MACINTOSH';
} elsif ($os =~ /os2/i) {
$os = 'OS2';
} else {
$os = 'UNIX';
}
# The path separator is a slash, backslash or semicolon, depending
# on the platform.
my $ps = {
UNIX => '/',
OS2 => '\\',
WINDOWS => '\\',
MACINTOSH => ':',
VMS => '\\'
}->{ $os };
#
# Thanks Lincoln!
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$self->{ OS } = $os;
$self->{ PATHSEP } = $ps;
}
#------------------------------------------------------------------------
# _dump()
#
# Dump internals for debugging.
#------------------------------------------------------------------------
sub _dump {
my $self = shift;
print "=" x 71, "\n";
print "Status of AppConfig::Sys (Version $VERSION) object: $self\n";
print " Operating System : ", $self->{ OS }, "\n";
print " Path Separator : ", $self->{ PATHSEP }, "\n";
print " Available methods :\n";
foreach my $can (keys %{ $self->{ CAN } }) {
printf "%20s : ", $can;
print $self->{ CAN }->{ $can } ? "yes" : "no", "\n";
}
print "=" x 71, "\n";
}
1;
__END__
=pod
=head1 NAME
AppConfig::Sys - Perl5 module defining platform-specific information and methods for other AppConfig::* modules.
=head1 SYNOPSIS
use AppConfig::Sys;
my $sys = AppConfig::Sys->new();
@fields = $sys->getpwuid($userid);
@fields = $sys->getpwnam($username);
=head1 OVERVIEW
AppConfig::Sys is a Perl5 module provides platform-specific information and
operations as required by other AppConfig::* modules.
AppConfig::Sys is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::Sys MODULE
To import and use the AppConfig::Sys module the following line should
appear in your Perl script:
use AppConfig::Sys;
AppConfig::Sys is implemented using object-oriented methods. A new
AppConfig::Sys object is created and initialised using the
AppConfig::Sys->new() method. This returns a reference to a new
AppConfig::Sys object.
my $sys = AppConfig::Sys->new();
This will attempt to detect your operating system and create a reference to
a new AppConfig::Sys object that is applicable to your platform. You may
explicitly specify an operating system name to override this automatic
detection:
$unix_sys = AppConfig::Sys->new("Unix");
Alternatively, the package variable $AppConfig::Sys::OS can be set to an
operating system name. The valid operating system names are: Win32, VMS,
Mac, OS2 and Unix. They are not case-specific.
=head2 AppConfig::Sys METHODS
AppConfig::Sys defines the following methods:
=over 4
=item getpwnam()
Calls the system function getpwnam() if available and returns the result.
Returns undef if not available. The can_getpwnam() method can be called to
determine if this function is available.
=item getpwuid()
Calls the system function getpwuid() if available and returns the result.
Returns undef if not available. The can_getpwuid() method can be called to
determine if this function is available.
=back
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<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 term of the Perl Artistic License.
=head1 SEE ALSO
AppConfig, AppConfig::File
=cut