appconfig-1.66.orig/0000755000000000000000000000000010643431405011241 5ustar appconfig-1.66.orig/Changes0000644000000000000000000001334010643431343012536 0ustar #======================================================================== # Version 1.66 Date: 2007/07/06 (Andy Wardley) #======================================================================== * Removed File::HomeDir from the test scripts. #======================================================================== # Version 1.65 Date: 2007/05/30 (Andy Wardley) #======================================================================== * Changed meaning of '~' interpolation to mean $ENV{HOME} rather than $ENV{HOME} or wherever File::HomeDir thinks your home directory is. This allows us to remove the dependency on File::HomeDir which was causing insallation problems (particularly on Mac OSX), and led to a long dependency chain for AppConfig and other modules that rely on it (like Template Toolkit). #======================================================================== # Version 1.64 Date: 2007/01/02 (Adam Kennedy) #======================================================================== * Bug fix to prevent crashing for users with no home directory * Increase File::HomeDir dep to 0.61 which supports no home directory cases properly. #======================================================================== # Version 1.63 Date: 2006/08/03 (Adam Kennedy) #======================================================================== * Unified version numbers and removed repository magic * Removed "use warnings" to get the Perl version dependency back to 5.005 * Removed "use base Exporter" which doesn't always work * Use File::HomeDir to find $HOME instead of doing it ourself, sorta * Fixed a POD bug in AppConfig::Sys and added a 99_pod.t test * Added a LICENSE file #======================================================================== # Version 1.56 Date: 2004/02/04 #======================================================================== * Applied a patch from Jianhong Feng to add "heredoc" style quoting. * Applied patch from Dave Viner to AppConfig::Sys to fix problems on Win32. Thanks also to Ijon Tichy for a similar patch. * Applied patch from Axel Gerstmair to prevent undefined variable warnings in block.t test. #======================================================================== # Version 1.55 Date: 2003/04/29 #======================================================================== * Fixed version numbers of various files which had got out-of-step with CPAN. #======================================================================== # Version 1.54 Date: 2003/04/29 #======================================================================== * Added POSIX style '=value' suffixes to --parameters. Thus '--foo=bar' is now equivalent to '-foo bar'. * Added AppConfig::CGI module to parse CGI script parameters. * Added cgi() delegate method to AppConfig to instantiate and call AppConfig::CGI. * Added CGI documentation and cleaned up copious typos, grammos and thinkos. * Applied documentation patches from Tim Mooney. * Fixed missing '>' tyop which caused POD to complain. Thanks to David Cantrell and many others for reporting it. * Applied patch from Steven McDowall to provide default options for LIST and HASH data types. * Applied patch from Robert Goff to allow '$' to be escaped (e.g. \$) to suppress variable expansion in files. * Applied patch from John Salmon to allow comments to appear anywhere on a line, not just at the beginning. #======================================================================== # Version 1.53 Date: not released #======================================================================== * various changes, incorporated above. #======================================================================== # Version 1.52 Date: 1998/10/29 11:44:23 Author: abw #======================================================================== * Modified AppConfig::Getopt to work with Getopt::Long version 2.17, instead of the yet-to-be-released-as-of-29-Oct-1998 version 2.93 (3.00 beta). Getopt::Long version 3.00 offers object-orientation but will continue to be backwardly compatible with earlier versions. Thus, AppConfig::Getopt should continue with future versions of Getopt::Long. Nice one, Johan! * Added code to AppConfig::State::define() to handle the compact format. The ALIAS and ARGS options are extracted from it and the ARGCOUNT is determined from the ARGS parameter. * Added Getopt::Long version 2.17 as a dependency in Makefile.PL. Added documentation to note this and explain how to modify the Makefile.PL to avoid this check. * Added t/compact.t and expanded t/getopt.t test files. * Added documentation for AppConfig::Getopt use and the compact definition format. * Added documentation for +/- prefix format in configuration files. * Other minor documentation fixes. #======================================================================== # Version 1.51 Date: 1998/10/22 09:22:53 Author: abw #======================================================================== * Added '+variable' (set on) and '-variable' (reset to 0 or default) syntax for configuration files, as suggested by Chip Salzenberg. * Fixed auto-creation of variables that was generating two warning messages each time. * Removed some straggling references to the AppConfig::Const module. * Changed Makefile.PL to explicitly list MAN3PODS for all AppConfig::* modules. ExtUtils::MakeMaker ignores files that match the pattern /(config|setup).*\.pm/i; Thanks to Alex Medina for catching that. #======================================================================== # Version 1.50 Date: 1998/10/21 09:28:15 Author: abw #======================================================================== * Completed documentation. * First public beta release. appconfig-1.66.orig/lib/0000755000000000000000000000000010643431405012007 5ustar appconfig-1.66.orig/lib/AppConfig/0000755000000000000000000000000010643431405013655 5ustar appconfig-1.66.orig/lib/AppConfig/Args.pm0000644000000000000000000001677710627257324015141 0ustar #============================================================================ # # 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 # # Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. #============================================================================ package AppConfig::Args; use strict; use warnings; use AppConfig::State; our $VERSION = '1.65'; #------------------------------------------------------------------------ # 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 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, Eabw@wardley.orgE =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 appconfig-1.66.orig/lib/AppConfig/CGI.pm0000644000000000000000000001541710627257321014632 0ustar #============================================================================ # # 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 # # Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved. # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. # #============================================================================ package AppConfig::CGI; use strict; use warnings; use AppConfig::State; our $VERSION = '1.65'; #------------------------------------------------------------------------ # 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 = "

\n[ AppConfig::CGI error: $format ] \n

\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 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, Cabw@wardley.org> =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 appconfig-1.66.orig/lib/AppConfig/File.pm0000644000000000000000000005702210627257331015106 0ustar #============================================================================ # # 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 # # Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. # #============================================================================ package AppConfig::File; use strict; use warnings; use AppConfig; use AppConfig::State; our $VERSION = '1.65'; #------------------------------------------------------------------------ # 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 = ''; 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$/) { # '<) { 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{ (? $(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 } : ""); } } 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 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 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 = < 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, Eabw@wardley.orgE =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 appconfig-1.66.orig/lib/AppConfig/Getopt.pm0000644000000000000000000002010510627257340015461 0ustar #============================================================================ # # 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 # # Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. # #============================================================================ package AppConfig::Getopt; use strict; use warnings; use AppConfig::State; use Getopt::Long 2.17; our $VERSION = '1.65'; #------------------------------------------------------------------------ # 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 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, Eabw@wardley.orgE =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 appconfig-1.66.orig/lib/AppConfig/State.pm0000644000000000000000000013403110627257344015307 0ustar #============================================================================ # # AppConfig::State.pm # # Perl5 module in which configuration information for an application can # be stored and manipulated. AppConfig::State objects maintain knowledge # about variables; their identities, options, aliases, targets, callbacks # and so on. This module is used by a number of other AppConfig::* modules. # # Written by Andy Wardley # # Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. # #---------------------------------------------------------------------------- # # TODO # # * Change varlist() to varhash() and provide another varlist() method # which returns a list. Multiple parameters passed implies a hash # slice/list grep, a single parameter should indicate a regex. # # * Perhaps allow a callback to be installed which is called *instead* of # the get() and set() methods (or rather, is called by them). # # * Maybe CMDARG should be in there to specify extra command-line only # options that get added to the AppConfig::GetOpt alias construction, # but not applied in config files, general usage, etc. The GLOBAL # CMDARG might be specified as a format, e.g. "-%c" where %s = name, # %c = first character, %u - first unique sequence(?). Will # GetOpt::Long handle --long to -l application automagically? # # * ..and an added thought is that CASE sensitivity may be required for the # command line (-v vs -V, -r vs -R, for example), but not for parsing # config files where you may wish to treat "Name", "NAME" and "name" alike. # #============================================================================ package AppConfig::State; use strict; use warnings; our $VERSION = '1.65'; our $DEBUG = 0; our $AUTOLOAD; # need access to AppConfig::ARGCOUNT_* use AppConfig ':argcount'; # internal per-variable hashes that AUTOLOAD should provide access to my %METHVARS; @METHVARS{ qw( EXPAND ARGS ARGCOUNT ) } = (); # internal values that AUTOLOAD should provide access to my %METHFLAGS; @METHFLAGS{ qw( PEDANTIC ) } = (); # variable attributes that may be specified in GLOBAL; my @GLOBAL_OK = qw( DEFAULT EXPAND VALIDATE ACTION ARGS ARGCOUNT ); #------------------------------------------------------------------------ # new(\%config, @vars) # # Module constructor. A reference to a hash array containing # configuration options may be passed as the first parameter. This is # passed off to _configure() for processing. See _configure() for # information about configurarion options. The remaining parameters # may be variable definitions and are passed en masse to define() for # processing. # # Returns a reference to a newly created AppConfig::State object. #------------------------------------------------------------------------ sub new { my $class = shift; my $self = { # internal hash arrays to store variable specification information VARIABLE => { }, # variable values DEFAULT => { }, # default values ALIAS => { }, # known aliases ALIAS => VARIABLE ALIASES => { }, # reverse alias lookup VARIABLE => ALIASES ARGCOUNT => { }, # arguments expected ARGS => { }, # specific argument pattern (AppConfig::Getopt) EXPAND => { }, # variable expansion (AppConfig::File) VALIDATE => { }, # validation regexen or functions ACTION => { }, # callback functions for when variable is set GLOBAL => { }, # default global settings for new variables # other internal data CREATE => 0, # auto-create variables when set CASE => 0, # case sensitivity flag (1 = sensitive) PEDANTIC => 0, # return immediately on parse warnings EHANDLER => undef, # error handler (let's hope we don't need it!) ERROR => '', # error message }; bless $self, $class; # configure if first param is a config hash ref $self->_configure(shift) if ref($_[0]) eq 'HASH'; # call define(@_) to handle any variables definitions $self->define(@_) if @_; return $self; } #------------------------------------------------------------------------ # define($variable, \%cfg, [$variable, \%cfg, ...]) # # Defines one or more variables. The first parameter specifies the # variable name. The following parameter may reference a hash of # configuration options for the variable. Further variables and # configuration hashes may follow and are processed in turn. If the # parameter immediately following a variable name isn't a hash reference # then it is ignored and the variable is defined without a specific # configuration, although any default parameters as specified in the # GLOBAL option will apply. # # The $variable value may contain an alias/args definition in compact # format, such as "Foo|Bar=1". # # A warning is issued (via _error()) if an invalid option is specified. #------------------------------------------------------------------------ sub define { my $self = shift; my ($var, $args, $count, $opt, $val, $cfg, @names); while (@_) { $var = shift; $cfg = ref($_[0]) eq 'HASH' ? shift : { }; # variable may be specified in compact format, 'foo|bar=i@' if ($var =~ s/(.+?)([!+=:].*)/$1/) { # anything coming after the name|alias list is the ARGS $cfg->{ ARGS } = $2 if length $2; } # examine any ARGS option if (defined ($args = $cfg->{ ARGS })) { ARGGCOUNT: { $count = ARGCOUNT_NONE, last if $args =~ /^!/; $count = ARGCOUNT_LIST, last if $args =~ /@/; $count = ARGCOUNT_HASH, last if $args =~ /%/; $count = ARGCOUNT_ONE; } $cfg->{ ARGCOUNT } = $count; } # split aliases out @names = split(/\|/, $var); $var = shift @names; $cfg->{ ALIAS } = [ @names ] if @names; # variable name gets folded to lower unless CASE sensitive $var = lc $var unless $self->{ CASE }; # activate $variable (so it does 'exist()') $self->{ VARIABLE }->{ $var } = undef; # merge GLOBAL and variable-specific configurations $cfg = { %{ $self->{ GLOBAL } }, %$cfg }; # examine each variable configuration parameter while (($opt, $val) = each %$cfg) { $opt = uc $opt; # DEFAULT, VALIDATE, EXPAND, ARGS and ARGCOUNT are stored as # they are; $opt =~ /^DEFAULT|VALIDATE|EXPAND|ARGS|ARGCOUNT$/ && do { $self->{ $opt }->{ $var } = $val; next; }; # CMDARG has been deprecated $opt eq 'CMDARG' && do { $self->_error("CMDARG has been deprecated. " . "Please use an ALIAS if required."); next; }; # ACTION should be a code ref $opt eq 'ACTION' && do { unless (ref($val) eq 'CODE') { $self->_error("'$opt' value is not a code reference"); next; }; # store code ref, forcing keyword to upper case $self->{ ACTION }->{ $var } = $val; next; }; # ALIAS creates alias links to the variable name $opt eq 'ALIAS' && do { # coerce $val to an array if not already so $val = [ split(/\|/, $val) ] unless ref($val) eq 'ARRAY'; # fold to lower case unless CASE sensitivity set unless ($self->{ CASE }) { @$val = map { lc } @$val; } # store list of aliases... $self->{ ALIASES }->{ $var } = $val; # ...and create ALIAS => VARIABLE lookup hash entries foreach my $a (@$val) { $self->{ ALIAS }->{ $a } = $var; } next; }; # default $self->_error("$opt is not a valid configuration item"); } # set variable to default value $self->_default($var); # DEBUG: dump new variable definition if ($DEBUG) { print STDERR "Variable defined:\n"; $self->_dump_var($var); } } } #------------------------------------------------------------------------ # get($variable) # # Returns the value of the variable specified, $variable. Returns undef # if the variable does not exists or is undefined and send a warning # message to the _error() function. #------------------------------------------------------------------------ sub get { my $self = shift; my $variable = shift; my $negate = 0; my $value; # _varname returns variable name after aliasing and case conversion # $negate indicates if the name got converted from "no" to "" $variable = $self->_varname($variable, \$negate); # check the variable has been defined unless (exists($self->{ VARIABLE }->{ $variable })) { $self->_error("$variable: no such variable"); return undef; } # DEBUG print STDERR "$self->get($variable) => ", defined $self->{ VARIABLE }->{ $variable } ? $self->{ VARIABLE }->{ $variable } : "", "\n" if $DEBUG; # return variable value, possibly negated if the name was "no" $value = $self->{ VARIABLE }->{ $variable }; return $negate ? !$value : $value; } #------------------------------------------------------------------------ # set($variable, $value) # # Assigns the value, $value, to the variable specified. # # Returns 1 if the variable is successfully updated or 0 if the variable # does not exist. If an ACTION sub-routine exists for the variable, it # will be executed and its return value passed back. #------------------------------------------------------------------------ sub set { my $self = shift; my $variable = shift; my $value = shift; my $negate = 0; my $create; # _varname returns variable name after aliasing and case conversion # $negate indicates if the name got converted from "no" to "" $variable = $self->_varname($variable, \$negate); # check the variable exists if (exists($self->{ VARIABLE }->{ $variable })) { # variable found, so apply any value negation $value = $value ? 0 : 1 if $negate; } else { # auto-create variable if CREATE is 1 or a pattern matching # the variable name (real name, not an alias) $create = $self->{ CREATE }; if (defined $create && ($create eq '1' || $variable =~ /$create/)) { $self->define($variable); print STDERR "Auto-created $variable\n" if $DEBUG; } else { $self->_error("$variable: no such variable"); return 0; } } # call the validate($variable, $value) method to perform any validation unless ($self->_validate($variable, $value)) { $self->_error("$variable: invalid value: $value"); return 0; } # DEBUG print STDERR "$self->set($variable, ", defined $value ? $value : "", ")\n" if $DEBUG; # set the variable value depending on its ARGCOUNT my $argcount = $self->{ ARGCOUNT }->{ $variable }; $argcount = AppConfig::ARGCOUNT_ONE unless defined $argcount; if ($argcount eq AppConfig::ARGCOUNT_LIST) { # push value onto the end of the list push(@{ $self->{ VARIABLE }->{ $variable } }, $value); } elsif ($argcount eq AppConfig::ARGCOUNT_HASH) { # insert "=" data into hash my ($k, $v) = split(/\s*=\s*/, $value, 2); # strip quoting $v =~ s/^(['"])(.*)\1$/$2/ if defined $v; $self->{ VARIABLE }->{ $variable }->{ $k } = $v; } else { # set simple variable $self->{ VARIABLE }->{ $variable } = $value; } # call any ACTION function bound to this variable return &{ $self->{ ACTION }->{ $variable } }($self, $variable, $value) if (exists($self->{ ACTION }->{ $variable })); # ...or just return 1 (ok) return 1; } #------------------------------------------------------------------------ # varlist($criteria, $filter) # # Returns a hash array of all variables and values whose real names # match the $criteria regex pattern passed as the first parameter. # If $filter is set to any true value, the keys of the hash array # (variable names) will have the $criteria part removed. This allows # the caller to specify the variables from one particular [block] and # have the "block_" prefix removed, for example. # # TODO: This should be changed to varhash(). varlist() should return a # list. Also need to consider specification by list rather than regex. # #------------------------------------------------------------------------ sub varlist { my $self = shift; my $criteria = shift; my $strip = shift; $criteria = "" unless defined $criteria; # extract relevant keys and slice out corresponding values my @keys = grep(/$criteria/, keys %{ $self->{ VARIABLE } }); my @vals = @{ $self->{ VARIABLE } }{ @keys }; my %set; # clean off the $criteria part if $strip is set @keys = map { s/$criteria//; $_ } @keys if $strip; # slice values into the target hash @set{ @keys } = @vals; return %set; } #------------------------------------------------------------------------ # AUTOLOAD # # Autoload function called whenever an unresolved object method is # called. If the method name relates to a defined VARIABLE, we patch # in $self->get() and $self->set() to magically update the varaiable # (if a parameter is supplied) and return the previous value. # # Thus the function can be used in the folowing ways: # $state->variable(123); # set a new value # $foo = $state->variable(); # get the current value # # Returns the current value of the variable, taken before any new value # is set. Prints a warning if the variable isn't defined (i.e. doesn't # exist rather than exists with an undef value) and returns undef. #------------------------------------------------------------------------ sub AUTOLOAD { my $self = shift; my ($variable, $attrib); # splat the leading package name ($variable = $AUTOLOAD) =~ s/.*:://; # ignore destructor $variable eq 'DESTROY' && return; # per-variable attributes and internal flags listed as keys in # %METHFLAGS and %METHVARS respectively can be accessed by a # method matching the attribute or flag name in lower case with # a leading underscore_ if (($attrib = $variable) =~ s/_//g) { $attrib = uc $attrib; if (exists $METHFLAGS{ $attrib }) { return $self->{ $attrib }; } if (exists $METHVARS{ $attrib }) { # next parameter should be variable name $variable = shift; $variable = $self->_varname($variable); # check we've got a valid variable # $self->_error("$variable: no such variable or method"), # return undef # unless exists($self->{ VARIABLE }->{ $variable }); # return attribute return $self->{ $attrib }->{ $variable }; } } # set a new value if a parameter was supplied or return the old one return defined($_[0]) ? $self->set($variable, shift) : $self->get($variable); } #======================================================================== # ----- PRIVATE METHODS ----- #======================================================================== #------------------------------------------------------------------------ # _configure(\%cfg) # # Sets the various configuration options using the values passed in the # hash array referenced by $cfg. #------------------------------------------------------------------------ sub _configure { my $self = shift; my $cfg = shift || return; # construct a regex to match values which are ok to be found in GLOBAL my $global_ok = join('|', @GLOBAL_OK); foreach my $opt (keys %$cfg) { # GLOBAL must be a hash ref $opt =~ /^GLOBALS?$/i && do { unless (ref($cfg->{ $opt }) eq 'HASH') { $self->_error("\U$opt\E parameter is not a hash ref"); next; } # we check each option is ok to be in GLOBAL, but we don't do # any error checking on the values they contain (but should?). foreach my $global ( keys %{ $cfg->{ $opt } } ) { # continue if the attribute is ok to be GLOBAL next if ($global =~ /(^$global_ok$)/io); $self->_error( "\U$global\E parameter cannot be GLOBAL"); } $self->{ GLOBAL } = $cfg->{ $opt }; next; }; # CASE, CREATE and PEDANTIC are stored as they are $opt =~ /^CASE|CREATE|PEDANTIC$/i && do { $self->{ uc $opt } = $cfg->{ $opt }; next; }; # ERROR triggers $self->_ehandler() $opt =~ /^ERROR$/i && do { $self->_ehandler($cfg->{ $opt }); next; }; # DEBUG triggers $self->_debug() $opt =~ /^DEBUG$/i && do { $self->_debug($cfg->{ $opt }); next; }; # warn about invalid options $self->_error("\U$opt\E is not a valid configuration option"); } } #------------------------------------------------------------------------ # _varname($variable, \$negated) # # Variable names are treated case-sensitively or insensitively, depending # on the value of $self->{ CASE }. When case-insensitive ($self->{ CASE } # != 0), all variable names are converted to lower case. Variable values # are not converted. This function simply converts the parameter # (variable) to lower case if $self->{ CASE } isn't set. _varname() also # expands a variable alias to the name of the target variable. # # Variables with an ARGCOUNT of ARGCOUNT_ZERO may be specified as # "no" in which case, the intended value should be negated. The # leading "no" part is stripped from the variable name. A reference to # a scalar value can be passed as the second parameter and if the # _varname() method identified such a variable, it will negate the value. # This allows the intended value or a simple negate flag to be passed by # reference and be updated to indicate any negation activity taking place. # # The (possibly modified) variable name is returned. #------------------------------------------------------------------------ sub _varname { my $self = shift; my $variable = shift; my $negated = shift; # convert to lower case if case insensitive $variable = $self->{ CASE } ? $variable : lc $variable; # get the actual name if this is an alias $variable = $self->{ ALIAS }->{ $variable } if (exists($self->{ ALIAS }->{ $variable })); # if the variable doesn't exist, we can try to chop off a leading # "no" and see if the remainder matches an ARGCOUNT_ZERO variable unless (exists($self->{ VARIABLE }->{ $variable })) { # see if the variable is specified as "no" if ($variable =~ /^no(.*)/) { # see if the real variable (minus "no") exists and it # has an ARGOUNT of ARGCOUNT_NONE (or no ARGCOUNT at all) my $novar = $self->_varname($1); if (exists($self->{ VARIABLE }->{ $novar }) && ! $self->{ ARGCOUNT }->{ $novar }) { # set variable name and negate value $variable = $novar; $$negated = ! $$negated if defined $negated; } } } # return the variable name $variable; } #------------------------------------------------------------------------ # _default($variable) # # Sets the variable specified to the default value or undef if it doesn't # have a default. The default value is returned. #------------------------------------------------------------------------ sub _default { my $self = shift; my $variable = shift; # _varname returns variable name after aliasing and case conversion $variable = $self->_varname($variable); # check the variable exists if (exists($self->{ VARIABLE }->{ $variable })) { # set variable value to the default scalar, an empty list or empty # hash array, depending on its ARGCOUNT value my $argcount = $self->{ ARGCOUNT }->{ $variable }; $argcount = AppConfig::ARGCOUNT_ONE unless defined $argcount; if ($argcount == AppConfig::ARGCOUNT_NONE) { return $self->{ VARIABLE }->{ $variable } = $self->{ DEFAULT }->{ $variable } || 0; } elsif ($argcount == AppConfig::ARGCOUNT_LIST) { my $deflist = $self->{ DEFAULT }->{ $variable }; return $self->{ VARIABLE }->{ $variable } = [ ref $deflist eq 'ARRAY' ? @$deflist : ( ) ]; } elsif ($argcount == AppConfig::ARGCOUNT_HASH) { my $defhash = $self->{ DEFAULT }->{ $variable }; return $self->{ VARIABLE }->{ $variable } = { ref $defhash eq 'HASH' ? %$defhash : () }; } else { return $self->{ VARIABLE }->{ $variable } = $self->{ DEFAULT }->{ $variable }; } } else { $self->_error("$variable: no such variable"); return 0; } } #------------------------------------------------------------------------ # _exists($variable) # # Returns 1 if the variable specified exists or 0 if not. #------------------------------------------------------------------------ sub _exists { my $self = shift; my $variable = shift; # _varname returns variable name after aliasing and case conversion $variable = $self->_varname($variable); # check the variable has been defined return exists($self->{ VARIABLE }->{ $variable }); } #------------------------------------------------------------------------ # _validate($variable, $value) # # Uses any validation rules or code defined for the variable to test if # the specified value is acceptable. # # Returns 1 if the value passed validation checks, 0 if not. #------------------------------------------------------------------------ sub _validate { my $self = shift; my $variable = shift; my $value = shift; my $validator; # _varname returns variable name after aliasing and case conversion $variable = $self->_varname($variable); # return OK unless there is a validation function return 1 unless defined($validator = $self->{ VALIDATE }->{ $variable }); # # the validation performed is based on the validator type; # # CODE ref: code executed, returning 1 (ok) or 0 (failed) # SCALAR : a regex which should match the value # # CODE ref ref($validator) eq 'CODE' && do { # run the validation function and return the result return &$validator($variable, $value); }; # non-ref (i.e. scalar) ref($validator) || do { # not a ref - assume it's a regex return $value =~ /$validator/; }; # validation failed return 0; } #------------------------------------------------------------------------ # _error($format, @params) # # Checks for the existence of a user defined error handling routine and # if defined, passes all variable straight through to that. The routine # is expected to handle a string format and optional parameters as per # printf(3C). If no error handler is defined, the message is formatted # and passed to warn() which prints it to STDERR. #------------------------------------------------------------------------ sub _error { my $self = shift; my $format = shift; # user defined error handler? if (ref($self->{ EHANDLER }) eq 'CODE') { &{ $self->{ EHANDLER } }($format, @_); } else { warn(sprintf("$format\n", @_)); } } #------------------------------------------------------------------------ # _ehandler($handler) # # Allows a new error handler to be installed. The current value of # the error handler is returned. # # This is something of a kludge to allow other AppConfig::* modules to # install their own error handlers to format error messages appropriately. # For example, AppConfig::File appends a message of the form # "at $file line $line" to each error message generated while parsing # configuration files. The previous handler is returned (and presumably # stored by the caller) to allow new error handlers to chain control back # to any user-defined handler, and also restore the original handler when # done. #------------------------------------------------------------------------ sub _ehandler { my $self = shift; my $handler = shift; # save previous value my $previous = $self->{ EHANDLER }; # update internal reference if a new handler vas provide if (defined $handler) { # check this is a code reference if (ref($handler) eq 'CODE') { $self->{ EHANDLER } = $handler; # DEBUG print STDERR "installed new ERROR handler: $handler\n" if $DEBUG; } else { $self->_error("ERROR handler parameter is not a code ref"); } } return $previous; } #------------------------------------------------------------------------ # _debug($debug) # # Sets the package debugging variable, $AppConfig::State::DEBUG depending # on the value of the $debug parameter. 1 turns debugging on, 0 turns # debugging off. # # May be called as an object method, $state->_debug(1), or as a package # function, AppConfig::State::_debug(1). Returns the previous value of # $DEBUG, before any new value was applied. #------------------------------------------------------------------------ sub _debug { # object reference may not be present if called as a package function my $self = shift if ref($_[0]); my $newval = shift; # save previous value my $oldval = $DEBUG; # update $DEBUG if a new value was provided $DEBUG = $newval if defined $newval; # return previous value $oldval; } #------------------------------------------------------------------------ # _dump_var($var) # # Displays the content of the specified variable, $var. #------------------------------------------------------------------------ sub _dump_var { my $self = shift; my $var = shift; return unless defined $var; # $var may be an alias, so we resolve the real variable name my $real = $self->_varname($var); if ($var eq $real) { print STDERR "$var\n"; } else { print STDERR "$real ('$var' is an alias)\n"; $var = $real; } # for some bizarre reason, the variable VALUE is stored in VARIABLE # (it made sense at some point in time) printf STDERR " VALUE => %s\n", defined($self->{ VARIABLE }->{ $var }) ? $self->{ VARIABLE }->{ $var } : ""; # the rest of the values can be read straight out of their hashes foreach my $param (qw( DEFAULT ARGCOUNT VALIDATE ACTION EXPAND )) { printf STDERR " %-12s => %s\n", $param, defined($self->{ $param }->{ $var }) ? $self->{ $param }->{ $var } : ""; } # summarise all known aliases for this variable print STDERR " ALIASES => ", join(", ", @{ $self->{ ALIASES }->{ $var } }), "\n" if defined $self->{ ALIASES }->{ $var }; } #------------------------------------------------------------------------ # _dump() # # Dumps the contents of the Config object and all stored variables. #------------------------------------------------------------------------ sub _dump { my $self = shift; my $var; print STDERR "=" x 71, "\n"; print STDERR "Status of AppConfig::State (version $VERSION) object:\n\t$self\n"; print STDERR "- " x 36, "\nINTERNAL STATE:\n"; foreach (qw( CREATE CASE PEDANTIC EHANDLER ERROR )) { printf STDERR " %-12s => %s\n", $_, defined($self->{ $_ }) ? $self->{ $_ } : ""; } print STDERR "- " x 36, "\nVARIABLES:\n"; foreach $var (keys %{ $self->{ VARIABLE } }) { $self->_dump_var($var); } print STDERR "- " x 36, "\n", "ALIASES:\n"; foreach $var (keys %{ $self->{ ALIAS } }) { printf(" %-12s => %s\n", $var, $self->{ ALIAS }->{ $var }); } print STDERR "=" x 72, "\n"; } 1; __END__ =head1 NAME AppConfig::State - application configuration state =head1 SYNOPSIS use AppConfig::State; my $state = AppConfig::State->new(\%cfg); $state->define("foo"); # very simple variable definition $state->define("bar", \%varcfg); # variable specific configuration $state->define("foo|bar=i@"); # compact format $state->set("foo", 123); # trivial set/get examples $state->get("foo"); $state->foo(); # shortcut variable access $state->foo(456); # shortcut variable update =head1 OVERVIEW AppConfig::State is a Perl5 module to handle global configuration variables for perl programs. It maintains the state of any number of variables, handling default values, aliasing, validation, update callbacks and option arguments for use by other AppConfig::* modules. AppConfig::State is distributed as part of the AppConfig bundle. =head1 DESCRIPTION =head2 USING THE AppConfig::State MODULE To import and use the AppConfig::State module the following line should appear in your Perl script: use AppConfig::State; The AppConfig::State module is loaded automatically by the new() constructor of the AppConfig module. AppConfig::State is implemented using object-oriented methods. A new AppConfig::State object is created and initialised using the new() method. This returns a reference to a new AppConfig::State object. my $state = AppConfig::State->new(); This will create a reference to a new AppConfig::State with all configuration options set to their default values. You can initialise the object by passing a reference to a hash array containing configuration options: $state = AppConfig::State->new( { CASE => 1, ERROR => \&my_error, } ); The new() constructor of the AppConfig module automatically passes all parameters to the AppConfig::State new() constructor. Thus, any global configuration values and variable definitions for AppConfig::State are also applicable to AppConfig. The following configuration options may be specified. =over 4 =item CASE Determines if the variable names are treated case sensitively. Any non-zero value makes case significant when naming variables. By default, CASE is set to 0 and thus "Variable", "VARIABLE" and "VaRiAbLe" are all treated as "variable". =item CREATE By default, CREATE is turned off meaning that all variables accessed via set() (which includes access via shortcut such as C<$state-Evariable($value)> which delegates to set()) must previously have been defined via define(). When CREATE is set to 1, calling set($variable, $value) on a variable that doesn't exist will cause it to be created automatically. When CREATE is set to any other non-zero value, it is assumed to be a regular expression pattern. If the variable name matches the regex, the variable is created. This can be used to specify configuration file blocks in which variables should be created, for example: $state = AppConfig::State->new( { CREATE => '^define_', } ); In a config file: [define] name = fred # define_name gets created automatically [other] name = john # other_name doesn't - warning raised Note that a regex pattern specified in CREATE is applied to the real variable name rather than any alias by which the variables may be accessed. =item PEDANTIC The PEDANTIC option determines what action the configuration file (AppConfig::File) or argument parser (AppConfig::Args) should take on encountering a warning condition (typically caused when trying to set an undeclared variable). If PEDANTIC is set to any true value, the parsing methods will immediately return a value of 0 on encountering such a condition. If PEDANTIC is not set, the method will continue to parse the remainder of the current file(s) or arguments, returning 0 when complete. If no warnings or errors are encountered, the method returns 1. In the case of a system error (e.g. unable to open a file), the method returns undef immediately, regardless of the PEDANTIC option. =item ERROR Specifies a user-defined error handling routine. When the handler is called, a format string is passed as the first parameter, followed by any additional values, as per printf(3C). =item DEBUG Turns debugging on or off when set to 1 or 0 accordingly. Debugging may also be activated by calling _debug() as an object method (C<$state-E_debug(1)>) or as a package function (C), passing in a true/false value to set the debugging state accordingly. The package variable $AppConfig::State::DEBUG can also be set directly. The _debug() method returns the current debug value. If a new value is passed in, the internal value is updated, but the previous value is returned. Note that any AppConfig::File or App::Config::Args objects that are instantiated with a reference to an App::State will inherit the DEBUG (and also PEDANTIC) values of the state at that time. Subsequent changes to the AppConfig::State debug value will not affect them. =item GLOBAL The GLOBAL option allows default values to be set for the DEFAULT, ARGCOUNT, EXPAND, VALIDATE and ACTION options for any subsequently defined variables. $state = AppConfig::State->new({ GLOBAL => { DEFAULT => '', # default value for new vars ARGCOUNT => 1, # vars expect an argument ACTION => \&my_set_var, # callback when vars get set } }); Any attributes specified explicitly when a variable is defined will override any GLOBAL values. See L below which describes these options in detail. =back =head2 DEFINING VARIABLES The C function is used to pre-declare a variable and specify its configuration. $state->define("foo"); In the simple example above, a new variable called "foo" is defined. A reference to a hash array may also be passed to specify configuration information for the variable: $state->define("foo", { DEFAULT => 99, ALIAS => 'metavar1', }); Any variable-wide GLOBAL values passed to the new() constructor in the configuration hash will also be applied. Values explicitly specified in a variable's define() configuration will override the respective GLOBAL values. The following configuration options may be specified =over 4 =item DEFAULT The DEFAULT value is used to initialise the variable. $state->define("drink", { DEFAULT => 'coffee', }); print $state->drink(); # prints "coffee" =item ALIAS The ALIAS option allows a number of alternative names to be specified for this variable. A single alias should be specified as a string. Multiple aliases can be specified as a reference to an array of alternatives or as a string of names separated by vertical bars, '|'. e.g.: # either $state->define("name", { ALIAS => 'person', }); # or $state->define("name", { ALIAS => [ 'person', 'user', 'uid' ], }); # or $state->define("name", { ALIAS => 'person|user|uid', }); $state->user('abw'); # equivalent to $state->name('abw'); =item ARGCOUNT The ARGCOUNT option specifies the number of arguments that should be supplied for this variable. By default, no additional arguments are expected for variables (ARGCOUNT_NONE). The ARGCOUNT_* constants can be imported from the AppConfig module: use AppConfig ':argcount'; $state->define('foo', { ARGCOUNT => ARGCOUNT_ONE }); or can be accessed directly from the AppConfig package: use AppConfig; $state->define('foo', { ARGCOUNT => AppConfig::ARGCOUNT_ONE }); The following values for ARGCOUNT may be specified. =over 4 =item ARGCOUNT_NONE (0) Indicates that no additional arguments are expected. If the variable is identified in a confirguration file or in the command line arguments, it is set to a value of 1 regardless of whatever arguments follow it. =item ARGCOUNT_ONE (1) Indicates that the variable expects a single argument to be provided. The variable value will be overwritten with a new value each time it is encountered. =item ARGCOUNT_LIST (2) Indicates that the variable expects multiple arguments. The variable value will be appended to the list of previous values each time it is encountered. =item ARGCOUNT_HASH (3) Indicates that the variable expects multiple arguments and that each argument is of the form "key=value". The argument will be split into a key/value pair and inserted into the hash of values each time it is encountered. =back =item ARGS The ARGS option can also be used to specify advanced command line options for use with AppConfig::Getopt, which itself delegates to Getopt::Long. See those two modules for more information on the format and meaning of these options. $state->define("name", { ARGS => "=i@", }); =item EXPAND The EXPAND option specifies how the AppConfig::File processor should expand embedded variables in the configuration file values it reads. By default, EXPAND is turned off (EXPAND_NONE) and no expansion is made. The EXPAND_* constants can be imported from the AppConfig module: use AppConfig ':expand'; $state->define('foo', { EXPAND => EXPAND_VAR }); or can be accessed directly from the AppConfig package: use AppConfig; $state->define('foo', { EXPAND => AppConfig::EXPAND_VAR }); The following values for EXPAND may be specified. Multiple values should be combined with vertical bars , '|', e.g. C). =over 4 =item EXPAND_NONE Indicates that no variable expansion should be attempted. =item EXPAND_VAR Indicates that variables embedded as $var or $(var) should be expanded to the values of the relevant AppConfig::State variables. =item EXPAND_UID Indicates that '~' or '~uid' patterns in the string should be expanded to the current users ($<), or specified user's home directory. In the first case, C<~> is expanded to the value of the C environment variable. In the second case, the C method is used if it is available on your system (which it isn't on Win32). =item EXPAND_ENV Inidicates that variables embedded as ${var} should be expanded to the value of the relevant environment variable. =item EXPAND_ALL Equivalent to C). =item EXPAND_WARN Indicates that embedded variables that are not defined should raise a warning. If PEDANTIC is set, this will cause the read() method to return 0 immediately. =back =item VALIDATE Each variable may have a sub-routine or regular expression defined which is used to validate the intended value for a variable before it is set. If VALIDATE is defined as a regular expression, it is applied to the value and deemed valid if the pattern matches. In this case, the variable is then set to the new value. A warning message is generated if the pattern match fails. VALIDATE may also be defined as a reference to a sub-routine which takes as its arguments the name of the variable and its intended value. The sub-routine should return 1 or 0 to indicate that the value is valid or invalid, respectively. An invalid value will cause a warning error message to be generated. If the GLOBAL VALIDATE variable is set (see GLOBAL in L above) then this value will be used as the default VALIDATE for each variable unless otherwise specified. $state->define("age", { VALIDATE => '\d+', }); $state->define("pin", { VALIDATE => \&check_pin, }); =item ACTION The ACTION option allows a sub-routine to be bound to a variable as a callback that is executed whenever the variable is set. The ACTION is passed a reference to the AppConfig::State object, the name of the variable and the value of the variable. The ACTION routine may be used, for example, to post-process variable data, update the value of some other dependant variable, generate a warning message, etc. Example: $state->define("foo", { ACTION => \&my_notify }); sub my_notify { my $state = shift; my $var = shift; my $val = shift; print "$variable set to $value"; } $state->foo(42); # prints "foo set to 42" Be aware that calling C<$state-Eset()> to update the same variable from within the ACTION function will cause a recursive loop as the ACTION function is repeatedly called. =item =back =head2 DEFINING VARIABLES USING THE COMPACT FORMAT Variables may be defined in a compact format which allows any ALIAS and ARGS values to be specified as part of the variable name. This is designed to mimic the behaviour of Johan Vromans' Getopt::Long module. Aliases for a variable should be specified after the variable name, separated by vertical bars, '|'. Any ARGS parameter should be appended after the variable name(s) and/or aliases. The following examples are equivalent: $state->define("foo", { ALIAS => [ 'bar', 'baz' ], ARGS => '=i', }); $state->define("foo|bar|baz=i"); =head2 READING AND MODIFYING VARIABLE VALUES AppConfig::State defines two methods to manipulate variable values: set($variable, $value); get($variable); Both functions take the variable name as the first parameter and C takes an additional parameter which is the new value for the variable. C returns 1 or 0 to indicate successful or unsuccessful update of the variable value. If there is an ACTION routine associated with the named variable, the value returned will be passed back from C. The C function returns the current value of the variable. Once defined, variables may be accessed directly as object methods where the method name is the same as the variable name. i.e. $state->set("verbose", 1); is equivalent to $state->verbose(1); Without parameters, the current value of the variable is returned. If a parameter is specified, the variable is set to that value and the result of the set() operation is returned. $state->age(29); # sets 'age' to 29, returns 1 (ok) =head2 INTERNAL METHODS The interal (private) methods of the AppConfig::State class are listed below. They aren't intended for regular use and potential users should consider the fact that nothing about the internal implementation is guaranteed to remain the same. Having said that, the AppConfig::State class is intended to co-exist and work with a number of other modules and these are considered "friend" classes. These methods are provided, in part, as services to them. With this acknowledged co-operation in mind, it is safe to assume some stability in this core interface. The _varname() method can be used to determine the real name of a variable from an alias: $varname->_varname($alias); Note that all methods that take a variable name, including those listed below, can accept an alias and automatically resolve it to the correct variable name. There is no need to call _varname() explicitly to do alias expansion. The _varname() method will fold all variables names to lower case unless CASE sensititvity is set. The _exists() method can be used to check if a variable has been defined: $state->_exists($varname); The _default() method can be used to reset a variable to its default value: $state->_default($varname); The _expand() method can be used to determine the EXPAND value for a variable: print "$varname EXPAND: ", $state->_expand($varname), "\n"; The _argcount() method returns the value of the ARGCOUNT attribute for a variable: print "$varname ARGCOUNT: ", $state->_argcount($varname), "\n"; The _validate() method can be used to determine if a new value for a variable meets any validation criteria specified for it. The variable name and intended value should be passed in. The methods returns a true/false value depending on whether or not the validation succeeded: print "OK\n" if $state->_validate($varname, $value); The _pedantic() method can be called to determine the current value of the PEDANTIC option. print "pedantic mode is ", $state->_pedantic() ? "on" ; "off", "\n"; The _debug() method can be used to turn debugging on or off (pass 1 or 0 as a parameter). It can also be used to check the debug state, returning the current internal value of $AppConfig::State::DEBUG. If a new debug value is provided, the debug state is updated and the previous state is returned. $state->_debug(1); # debug on, returns previous value The _dump_var($varname) and _dump() methods may also be called for debugging purposes. $state->_dump_var($varname); # show variable state $state->_dump(); # show internal state and all vars =head1 AUTHOR Andy Wardley, Eabw@wardley.orgE =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::File, AppConfig::Args, AppConfig::Getopt =cut appconfig-1.66.orig/lib/AppConfig/Sys.pm0000644000000000000000000001745610627257352015017 0ustar #============================================================================ # # AppConfig::Sys.pm # # Perl5 module providing platform-specific information and operations as # required by other AppConfig::* modules. # # Written by Andy Wardley # # 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 strict; use warnings; use POSIX qw( getpwnam getpwuid ); our $VERSION = '1.65'; 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. =item =back =head1 AUTHOR Andy Wardley, Eabw@wardley.orgE =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 appconfig-1.66.orig/lib/AppConfig.pm0000644000000000000000000007740510643427453014240 0ustar #============================================================================ # # AppConfig.pm # # Perl5 module for reading and parsing configuration files and command line # arguments. # # Written by Andy Wardley # # Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. #========================================================================== package AppConfig; use strict; use warnings; use base 'Exporter'; our $VERSION = 1.66; # variable expansion constants use constant EXPAND_NONE => 0; use constant EXPAND_VAR => 1; use constant EXPAND_UID => 2; use constant EXPAND_ENV => 4; use constant EXPAND_ALL => EXPAND_VAR | EXPAND_UID | EXPAND_ENV; use constant EXPAND_WARN => 8; # argument count types use constant ARGCOUNT_NONE => 0; use constant ARGCOUNT_ONE => 1; use constant ARGCOUNT_LIST => 2; use constant ARGCOUNT_HASH => 3; # Exporter tagsets our @EXPAND = qw( EXPAND_NONE EXPAND_VAR EXPAND_UID EXPAND_ENV EXPAND_ALL EXPAND_WARN ); our @ARGCOUNT = qw( ARGCOUNT_NONE ARGCOUNT_ONE ARGCOUNT_LIST ARGCOUNT_HASH ); our @EXPORT_OK = ( @EXPAND, @ARGCOUNT ); our %EXPORT_TAGS = ( expand => [ @EXPAND ], argcount => [ @ARGCOUNT ], ); our $AUTOLOAD; require AppConfig::State; #------------------------------------------------------------------------ # new(\%config, @vars) # # Module constructor. All parameters passed are forwarded onto the # AppConfig::State constructor. Returns a reference to a newly created # AppConfig object. #------------------------------------------------------------------------ sub new { my $class = shift; bless { STATE => AppConfig::State->new(@_) }, $class; } #------------------------------------------------------------------------ # file(@files) # # The file() method is called to parse configuration files. An # AppConfig::File object is instantiated and stored internally for # use in subsequent calls to file(). #------------------------------------------------------------------------ sub file { my $self = shift; my $state = $self->{ STATE }; my $file; require AppConfig::File; # create an AppConfig::File object if one isn't defined $file = $self->{ FILE } ||= AppConfig::File->new($state); # call on the AppConfig::File object to process files. $file->parse(@_); } #------------------------------------------------------------------------ # args(\@args) # # The args() method is called to parse command line arguments. An # AppConfig::Args object is instantiated and then stored internally for # use in subsequent calls to args(). #------------------------------------------------------------------------ sub args { my $self = shift; my $state = $self->{ STATE }; my $args; require AppConfig::Args; # create an AppConfig::Args object if one isn't defined $args = $self->{ ARGS } ||= AppConfig::Args->new($state); # call on the AppConfig::Args object to process arguments. $args->parse(shift); } #------------------------------------------------------------------------ # getopt(@config, \@args) # # The getopt() method is called to parse command line arguments. The # AppConfig::Getopt module is require()'d and an AppConfig::Getopt object # is created to parse the arguments. #------------------------------------------------------------------------ sub getopt { my $self = shift; my $state = $self->{ STATE }; my $getopt; require AppConfig::Getopt; # create an AppConfig::Getopt object if one isn't defined $getopt = $self->{ GETOPT } ||= AppConfig::Getopt->new($state); # call on the AppConfig::Getopt object to process arguments. $getopt->parse(@_); } #------------------------------------------------------------------------ # cgi($query) # # The cgi() method is called to parse a CGI query string. An # AppConfig::CGI object is instantiated and then stored internally for # use in subsequent calls to args(). #------------------------------------------------------------------------ sub cgi { my $self = shift; my $state = $self->{ STATE }; my $cgi; require AppConfig::CGI; # create an AppConfig::CGI object if one isn't defined $cgi = $self->{ CGI } ||= AppConfig::CGI->new($state); # call on the AppConfig::CGI object to process a query. $cgi->parse(shift); } #------------------------------------------------------------------------ # AUTOLOAD # # Autoload function called whenever an unresolved object method is # called. All methods are delegated to the $self->{ STATE } # AppConfig::State object. # #------------------------------------------------------------------------ sub AUTOLOAD { my $self = shift; my $method; # splat the leading package name ($method = $AUTOLOAD) =~ s/.*:://; # ignore destructor $method eq 'DESTROY' && return; # delegate method call to AppConfig::State object in $self->{ STATE } $self->{ STATE }->$method(@_); } 1; __END__ =head1 NAME AppConfig - Perl5 module for reading configuration files and parsing command line arguments. =head1 SYNOPSIS use AppConfig; # create a new AppConfig object my $config = AppConfig->new( \%cfg ); # define a new variable $config->define( $varname => \%varopts ); # create/define combined my $config = AppConfig->new( \%cfg, $varname => \%varopts, $varname => \%varopts, ... ); # set/get the value $config->set( $varname, $value ); $config->get($varname); # shortcut form $config->varname($value); $config->varname; # read configuration file $config->file($file); # parse command line options $config->args(\@args); # default to \@ARGV # advanced command line options with Getopt::Long $config->getopt(\@args); # default to \@ARGV # parse CGI parameters (GET method) $config->cgi($query); # default to $ENV{ QUERY_STRING } =head1 OVERVIEW AppConfig is a Perl5 module for managing application configuration information. It maintains the state of any number of variables and provides methods for parsing configuration files, command line arguments and CGI script parameters. Variables values may be set via configuration files. Variables may be flags (On/Off), take a single value, or take multiple values stored as a list or hash. The number of arguments a variable expects is determined by its configuration when defined. # flags verbose nohelp debug = On # single value home = /home/abw/ # multiple list value file = /tmp/file1 file = /tmp/file2 # multiple hash value book camel = Programming Perl book llama = Learning Perl 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 can be applied (selectively, if necessary) to the values read from configuration files: home = ~ # home directory nntp = ${NNTPSERVER} # environment variable html = $home/html # internal variables img = $html/images Configuration files may be arranged in blocks as per the style of Win32 "INI" files. [file] site = kfs src = ~/websrc/docs/$site lib = ~/websrc/lib dest = ~/public_html/$site [page] header = $lib/header footer = $lib/footer You can also use Perl's "heredoc" syntax to define a large block of text in a configuration file. multiline = < and L modules should be installed. If you are using a recent version of Perl (e.g. 5.8.0) then these should already be installed. =head1 OBTAINING AND INSTALLING THE AppConfig MODULE BUNDLE The AppConfig module bundle is available from CPAN. As the 'perlmod' manual page explains: CPAN stands for the Comprehensive Perl Archive Network. This is a globally replicated collection of all known Perl materials, including hundreds of unbundled modules. [...] For an up-to-date listing of CPAN sites, see http://www.perl.com/perl/ or ftp://ftp.perl.com/perl/ . Within the CPAN archive, AppConfig is in the category: 12) Option, Argument, Parameter and Configuration File Processing The module is available in the following directories: /modules/by-module/AppConfig/AppConfig-.tar.gz /authors/id/ABW/AppConfig-.tar.gz AppConfig is distributed as a single gzipped tar archive file: AppConfig-.tar.gz Note that "" represents the current AppConfig version number, of the form "n.nn", e.g. "3.14". See the REVISION section below to determine the current version number for AppConfig. Unpack the archive to create a AppConfig installation directory: gunzip AppConfig-.tar.gz tar xvf AppConfig-.tar 'cd' into that directory, make, test and install the modules: cd AppConfig- perl Makefile.PL make make test make install The 't' sub-directory contains a number of test scripts that are run when a 'make test' is run. The 'make install' will install the module on your system. You may need administrator privileges to perform this task. If you install the module in a local directory (for example, by executing "perl Makefile.PL LIB=~/lib" in the above - see C for full details), you will need to ensure that the PERL5LIB environment variable is set to include the location, or add a line to your scripts explicitly naming the library location: use lib '/local/path/to/lib'; The 'examples' sub-directory contains some simple examples of using the AppConfig modules. =head1 DESCRIPTION =head2 USING THE AppConfig MODULE To import and use the L module the following line should appear in your Perl script: use AppConfig; To import constants defined by the AppConfig module, specify the name of one or more of the constant or tag sets as parameters to C: use AppConfig qw(:expand :argcount); See L below for more information on the constant tagsets defined by AppConfig. AppConfig is implemented using object-oriented methods. A new AppConfig object is created and initialised using the new() method. This returns a reference to a new AppConfig object. my $config = AppConfig->new(); This will create and return a reference to a new AppConfig object. In doing so, the AppConfig object also creates an internal reference to an AppConfig::State object in which to store variable state. All arguments passed into the AppConfig constructor are passed directly to the AppConfig::State constructor. The first (optional) parameter may be a reference to a hash array containing configuration information. my $config = AppConfig->new( { CASE => 1, ERROR => \&my_error, GLOBAL => { DEFAULT => "", ARGCOUNT => ARGCOUNT_ONE, }, } ); See L for full details of the configuration options available. These are, in brief: =over 4 =item CASE Used to set case sensitivity for variable names (default: off). =item CREATE Used to indicate that undefined variables should be created automatically (default: off). =item GLOBAL Reference to a hash array of global values used by default when defining variables. Valid global values are DEFAULT, ARGCOUNT, EXPAND, VALIDATE and ACTION. =item PEDANTIC Used to indicate that command line and configuration file parsing routines should return immediately on encountering an error. =item ERROR Used to provide a error handling routine. Arguments as per printf(). =back Subsequent parameters may be variable definitions. These are passed to the define() method, described below in L. my $config = AppConfig->new("foo", "bar", "baz"); my $config = AppConfig->new( { CASE => 1 }, qw(foo bar baz) ); Note that any unresolved method calls to AppConfig are automatically delegated to the AppConfig::State object. In practice, it means that it is possible to treat the AppConfig object as if it were an AppConfig::State object: # create AppConfig my $config = AppConfig->new('foo', 'bar'); # methods get passed through to internal AppConfig::State $config->foo(100); $config->set('bar', 200); $config->define('baz'); $config->baz(300); =head2 DEFINING VARIABLES The C method (delegated to AppConfig::State) is used to pre-declare a variable and specify its configuration. $config->define("foo"); Variables may also be defined directly from the AppConfig new() constructor. my $config = AppConfig->new("foo"); In both simple examples above, a new variable called "foo" is defined. A reference to a hash array may also be passed to specify configuration information for the variable: $config->define("foo", { DEFAULT => 99, ALIAS => 'metavar1', }); Configuration items specified in the GLOBAL option to the module constructor are applied by default when variables are created. e.g. my $config = AppConfig->new( { GLOBAL => { DEFAULT => "", ARGCOUNT => ARGCOUNT_ONE, } } ); $config->define("foo"); $config->define("bar", { ARGCOUNT => ARGCOUNT_NONE } ); is equivalent to: my $config = AppConfig->new(); $config->define( "foo", { DEFAULT => "", ARGCOUNT => ARGCOUNT_ONE, } ); $config->define( "bar", DEFAULT => "", ARGCOUNT => ARGCOUNT_NONE, } ); Multiple variables may be defined in the same call to define(). Configuration hashes for variables can be omitted. $config->define("foo", "bar" => { ALIAS = "boozer" }, "baz"); See L for full details of the configuration options available when defining variables. These are, in brief: =over =item DEFAULT The default value for the variable (default: undef). =item ALIAS One or more (list reference or "list|like|this") alternative names for the variable. =item ARGCOUNT Specifies the number and type of arguments that the variable expects. Constants in C<:expand> tag set define ARGCOUNT_NONE - simple on/off flag (default), ARGCOUNT_ONE - single value, ARGCOUNT_LIST - multiple values accessed via list reference, ARGCOUNT_HASH - hash table, "key=value", accessed via hash reference. =item ARGS Used to provide an argument specification string to pass to Getopt::Long via AppConfig::Getopt. E.g. "=i", ":s", "=s@". This can also be used to implicitly set the ARGCOUNT value (C = ARGCOUNT_NONE, C = ARGCOUNT_LIST, C = ARGCOUNT_HASH, C = ARGCOUNT_ONE) =item EXPAND Specifies which variable expansion policies should be used when parsing configuration files. Constants in C<:expand> tag set define: EXPAND_NONE - no expansion (default) EXPAND_VAR - expand C<$var> or C<$(var)> as other variables EXPAND_UID - expand C<~> and C<~uid> as user's home directory EXPAND_ENV - expand C<${var}> as environment variable EXPAND_ALL - do all expansions. =item VALIDATE Regex which the intended variable value should match or code reference which returns 1 to indicate successful validaton (variable may now be set). =item ACTION Code reference to be called whenever variable value changes. =back =head2 COMPACT FORMAT DEFINITION Variables can be specified using a compact format. This is identical to the specification format of Getopt::Long and is of the form: "name|alias|alias" The first element indicates the variable name and subsequent ALIAS values may be added, each separated by a vertical bar '|'. The EargoptsE element indicates the ARGCOUNT value and may be one of the following; ! ARGCOUNT_NONE =s ARGCOUNT_ONE =s@ ARGCOUNT_LIST =s% ARGCOUNT_HASH Additional constructs supported by Getopt::Long may be specified instead of the "=s" element (e.g. "=f"). The entire EargoptsE element is stored in the ARGS parameter for the variable and is passed intact to Getopt::Long when the getopt() method is called. The following examples demonstrate use of the comapct format, with their equivalent full specifications: $config->define("foo|bar|baz!"); $config->define( "foo" => { ALIAS => "bar|baz", ARGCOUNT => ARGCOUNT_NONE, }); $config->define("name=s"); $config->define( "name" => { ARGCOUNT => ARGCOUNT_ONE, }); $config->define("file|filelist|f=s@"); $config->define( "file" => { ALIAS => "filelist|f", ARGCOUNT => ARGCOUNT_LIST, }); $config->define("user|u=s%"); $config->define( "user" => { ALIAS => "u", ARGCOUNT => ARGCOUNT_HASH, }); Additional configuration options may be specified by hash reference, as per normal. The compact definition format will override any configuration values provided for ARGS and ARGCOUNT. $config->define("file|filelist|f=s@", { VALIDATE = \&check_file() } ); =head2 READING AND MODIFYING VARIABLE VALUES AppConfig defines two methods (via AppConfig::State) to manipulate variable values set($variable, $value); get($variable); Once defined, variables may be accessed directly as object methods where the method name is the same as the variable name. i.e. $config->set("verbose", 1); is equivalent to $config->verbose(1); Note that AppConfig defines the following methods: new(); file(); args(); getopt(); And also, through delegation to AppConfig::State: define() get() set() varlist() If you define a variable with one of the above names, you will not be able to access it directly as an object method. i.e. $config->file(); This will call the file() method, instead of returning the value of the 'file' variable. You can work around this by explicitly calling get() and set() on a variable whose name conflicts: $config->get('file'); or by defining a "safe" alias by which the variable can be accessed: $config->define("file", { ALIAS => "fileopt" }); or $config->define("file|fileopt"); ... $config->fileopt(); Without parameters, the current value of the variable is returned. If a parameter is specified, the variable is set to that value and the result of the set() operation is returned. $config->age(29); # sets 'age' to 29, returns 1 (ok) print $config->age(); # prints "29" The varlist() method can be used to extract a number of variables into a hash array. The first parameter should be a regular expression used for matching against the variable names. my %vars = $config->varlist("^file"); # all "file*" variables A second parameter may be specified (any true value) to indicate that the part of the variable name matching the regex should be removed when copied to the target hash. $config->file_name("/tmp/file"); $config->file_path("/foo:/bar:/baz"); my %vars = $config->varlist("^file_", 1); # %vars: # name => /tmp/file # path => "/foo:/bar:/baz" =head2 READING CONFIGURATION FILES The AppConfig module provides a streamlined interface for reading configuration files with the AppConfig::File module. The file() method automatically loads the AppConfig::File module and creates an object to process the configuration file or files. Variables stored in the internal AppConfig::State are automatically updated with values specified in the configuration file. $config->file($filename); Multiple files may be passed to file() and should indicate the file name or be a reference to an open file handle or glob. $config->file($filename, $filehandle, \*STDIN, ...); The file may contain blank lines and comments (prefixed by '#') which are ignored. Continutation lines may be marked by ending the line with a '\'. # this is a comment 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 (including any continuation lines). An optional 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 e="emacs" 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"; } 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 =head2 VARIABLE EXPANSION 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 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 =head2 PARSING COMMAND LINE OPTIONS There are two methods for processing command line options. The first, args(), is a small and efficient implementation which offers basic functionality. The second, getopt(), offers a more powerful and complete facility by delegating the task to Johan Vroman's Getopt::Long module. The trade-off between args() and getopt() is essentially one of speed/size against flexibility. Use as appropriate. Both implement on-demand loading of modules and incur no overhead until used. The args() method is used to parse simple command line options. It automatically loads the AppConfig::Args module and creates an object to process the command line arguments. Variables stored in the internal AppConfig::State are automatically updated with values specified in the arguments. The method should be passed a reference to a list of arguments to parse. The @ARGV array is used if args() is called without parameters. $config->args(\@myargs); $config->args(); # uses @ARGV Arguments are read and shifted from the array until the first is encountered that is not prefixed by '-' or '--'. At that point, the method returns 1 to indicate success, leaving any unprocessed arguments remaining in the list. Each argument should be the name or alias of a variable prefixed by '-' or '--'. Arguments that are not prefixed as such (and are not an additional parameter to a previous argument) will cause a warning to be raised. If the PEDANTIC option is set, the method will return 0 immediately. With PEDANTIC unset (default), the method will continue to parse the rest of the arguments, returning 0 when done. If the variable is a simple flag (ARGCOUNT = ARGCOUNT_NONE) then it is set to the value 1. The variable may be prefixed by "no" to set its value to 0. myprog -verbose --debug -notaste # $config->verbose(1) # $config->debug(1) # $config->taste(0) Variables that expect an additional argument (ARGCOUNT != 0) will be set to the value of the argument following it. myprog -f /tmp/myfile # $config->file('/tmp/file'); Variables that expect multiple values (ARGCOUNT = ARGCOUNT_LIST or ARGCOUNT_HASH) will have sucessive values added each time the option is encountered. myprog -file /tmp/foo -file /tmp/bar # $config->file('/tmp/foo') # $config->file('/tmp/bar') # file => [ '/tmp/foo', '/tmp/bar' ] myprog -door "jim=Jim Morrison" -door "ray=Ray Manzarek" # $config->door("jim=Jim Morrison"); # $config->door("ray=Ray Manzarek"); # door => { 'jim' => 'Jim Morrison', 'ray' => 'Ray Manzarek' } See L for further details on parsing command line arguments. The getopt() method provides a way to use the power and flexibility of the Getopt::Long module to parse command line arguments and have the internal values of the AppConfig object updates automatically. The first (non-list reference) parameters may contain a number of configuration string to pass to Getopt::Long::Configure. A reference to a list of arguments may additionally be passed or @ARGV is used by default. $config->getopt(); # uses @ARGV $config->getopt(\@myargs); $config->getopt(qw(auto_abbrev debug)); # uses @ARGV $config->getopt(qw(debug), \@myargs); See Getopt::Long for details of the configuration options available. The getopt() method constructs a specification string for each internal variable and then initialises Getopt::Long with these values. The specification string is constructed from the name, any aliases (delimited by a vertical bar '|') and the value of the ARGS parameter. $config->define("foo", { ARGS => "=i", ALIAS => "bar|baz", }); # Getopt::Long specification: "foo|bar|baz=i" Errors and warning generated by the Getopt::Long module are trapped and handled by the AppConfig error handler. This may be a user-defined routine installed with the ERROR configuration option. Please note that the AppConfig::Getopt interface is still experimental and may not be 100% operational. This is almost undoubtedly due to problems in AppConfig::Getopt rather than Getopt::Long. =head2 PARSING CGI PARAMETERS The cgi() method provides an interface to the AppConfig::CGI module for updating variable values based on the parameters appended to the URL for a CGI script. This is commonly known as the CGI "GET" method. The CGI "POST" method is currently not supported. Parameter definitions are separated from the CGI script name by a question mark and from each other by ampersands. Where variables have specific values, these are appended to the variable with an equals sign: http://www.here.com/cgi-bin/myscript?foo=bar&baz=qux&verbose # $config->foo('bar'); # $config->baz('qux'); # $config->verbose(1); Certain values specified in a URL must be escaped in the appropriate manner (see CGI specifications at http://www.w3c.org/ for full details). The AppConfig::CGI module automatically unescapes the CGI query string to restore the parameters to their intended values. http://where.com/mycgi?title=%22The+Wrong+Trousers%22 # $config->title('"The Wrong Trousers"'); Please be considerate of the security implications of providing writeable access to script variables via CGI. http://rebel.alliance.com/cgi-bin/... .../send_report?file=%2Fetc%2Fpasswd&email=darth%40empire.com To avoid any accidental or malicious changing of "private" variables, define only the "public" variables before calling the cgi() (or any other) method. Further variables can subequently be defined which can not be influenced by the CGI parameters. $config->define('verbose', 'debug') $config->cgi(); # can only set verbose and debug $config->define('email', 'file'); $config->file($cfgfile); # can set verbose, debug, email + file =head1 CONSTANT DEFINITIONS A number of constants are defined by the AppConfig module. These may be accessed directly (e.g. AppConfig::EXPAND_VARS) or by first importing them into the caller's package. Constants are imported by specifying their names as arguments to C or by importing a set of constants identified by its "tag set" name. use AppConfig qw(ARGCOUNT_NONE ARGCOUNT_ONE); use AppConfig qw(:argcount); The following tag sets are defined: =over 4 =item :expand The ':expand' tagset defines the following constants: EXPAND_NONE EXPAND_VAR EXPAND_UID EXPAND_ENV EXPAND_ALL # EXPAND_VAR | EXPAND_UID | EXPAND_ENV EXPAND_WARN See AppConfig::File for full details of the use of these constants. =item :argcount The ':argcount' tagset defines the following constants: ARGCOUNT_NONE ARGCOUNT_ONE ARGCOUNT_LIST ARGCOUNT_HASH See AppConfig::State for full details of the use of these constants. =back =head1 AUTHOR Andy Wardley, Eabw@wardley.orgE With contributions from Dave Viner, Ijon Tichy, Axel Gerstmair and many others whose names have been lost to the sands of time (reminders welcome). =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::State, AppConfig::File, AppConfig::Args, AppConfig::Getopt, AppConfig::CGI, Getopt::Long =cut appconfig-1.66.orig/LICENSE0000644000000000000000000004737110627254543012272 0ustar Terms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" ---------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ---------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End appconfig-1.66.orig/Makefile.PL0000644000000000000000000000202710643430437013220 0ustar use ExtUtils::MakeMaker; my %config = ( 'NAME' => 'AppConfig', 'VERSION_FROM' => 'lib/AppConfig.pm', # finds $VERSION 'PMLIBDIRS' => [ 'lib' ], 'PREREQ_PM' => { 'Test::More' => 0, }, 'MAN3PODS' => { # We must explicitly name AppConfig.pm et al as manifyable files. # MakeMaker ignores files that match /(config|setup).*\.pm/i; 'lib/AppConfig.pm' => '$(INST_MAN3DIR)/AppConfig.$(MAN3EXT)', map { ( "lib/AppConfig/${_}.pm", "\$(INST_MAN3DIR)/AppConfig::${_}.\$(MAN3EXT)" ) ; } qw( Args CGI File Getopt State Sys ), }, 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => 'gz', 'PREOP' => 'pod2text lib/AppConfig.pm > README', }, ); ## for PPD on win32 if ($] ge '5.005') { $config{ AUTHOR } = 'Andy Wardley ', $config{ ABSTRACT } = 'AppConfig is a bundle of Perl5 modules for reading configuration files and parsing command line arguments.'; } WriteMakefile(%config); appconfig-1.66.orig/MANIFEST0000644000000000000000000000066310627254543012407 0ustar Changes lib/AppConfig.pm lib/AppConfig/Args.pm lib/AppConfig/CGI.pm lib/AppConfig/File.pm lib/AppConfig/Getopt.pm lib/AppConfig/State.pm lib/AppConfig/Sys.pm LICENSE Makefile.PL MANIFEST README t/99_author.t t/appconfig.t t/args.t t/block.t t/cgi.t t/compact.t t/const.t t/default.t t/file.t t/flag.t t/getopt.t t/multi.t t/novars.t t/state.t t/sys.t TODO META.yml Module meta-data (added by MakeMaker) appconfig-1.66.orig/META.yml0000644000000000000000000000076210643431405012517 0ustar --- #YAML:1.0 name: AppConfig version: 1.66 abstract: AppConfig is a bundle of Perl5 modules for reading configuration files and parsing command line arguments. license: ~ generated_by: ExtUtils::MakeMaker version 6.31 distribution_type: module requires: Test::More: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - Andy Wardley appconfig-1.66.orig/README0000644000000000000000000007126310643431406012133 0ustar NAME AppConfig - Perl5 module for reading configuration files and parsing command line arguments. SYNOPSIS use AppConfig; # create a new AppConfig object my $config = AppConfig->new( \%cfg ); # define a new variable $config->define( $varname => \%varopts ); # create/define combined my $config = AppConfig->new( \%cfg, $varname => \%varopts, $varname => \%varopts, ... ); # set/get the value $config->set( $varname, $value ); $config->get($varname); # shortcut form $config->varname($value); $config->varname; # read configuration file $config->file($file); # parse command line options $config->args(\@args); # default to \@ARGV # advanced command line options with Getopt::Long $config->getopt(\@args); # default to \@ARGV # parse CGI parameters (GET method) $config->cgi($query); # default to $ENV{ QUERY_STRING } OVERVIEW AppConfig is a Perl5 module for managing application configuration information. It maintains the state of any number of variables and provides methods for parsing configuration files, command line arguments and CGI script parameters. Variables values may be set via configuration files. Variables may be flags (On/Off), take a single value, or take multiple values stored as a list or hash. The number of arguments a variable expects is determined by its configuration when defined. # flags verbose nohelp debug = On # single value home = /home/abw/ # multiple list value file = /tmp/file1 file = /tmp/file2 # multiple hash value book camel = Programming Perl book llama = Learning Perl 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 can be applied (selectively, if necessary) to the values read from configuration files: home = ~ # home directory nntp = ${NNTPSERVER} # environment variable html = $home/html # internal variables img = $html/images Configuration files may be arranged in blocks as per the style of Win32 "INI" files. [file] site = kfs src = ~/websrc/docs/$site lib = ~/websrc/lib dest = ~/public_html/$site [page] header = $lib/header footer = $lib/footer You can also use Perl's "heredoc" syntax to define a large block of text in a configuration file. multiline = <.tar.gz /authors/id/ABW/AppConfig-.tar.gz AppConfig is distributed as a single gzipped tar archive file: AppConfig-.tar.gz Note that "" represents the current AppConfig version number, of the form "n.nn", e.g. "3.14". See the REVISION section below to determine the current version number for AppConfig. Unpack the archive to create a AppConfig installation directory: gunzip AppConfig-.tar.gz tar xvf AppConfig-.tar 'cd' into that directory, make, test and install the modules: cd AppConfig- perl Makefile.PL make make test make install The 't' sub-directory contains a number of test scripts that are run when a 'make test' is run. The 'make install' will install the module on your system. You may need administrator privileges to perform this task. If you install the module in a local directory (for example, by executing "perl Makefile.PL LIB=~/lib" in the above - see "perldoc MakeMaker" for full details), you will need to ensure that the PERL5LIB environment variable is set to include the location, or add a line to your scripts explicitly naming the library location: use lib '/local/path/to/lib'; The 'examples' sub-directory contains some simple examples of using the AppConfig modules. DESCRIPTION USING THE AppConfig MODULE To import and use the AppConfig module the following line should appear in your Perl script: use AppConfig; To import constants defined by the AppConfig module, specify the name of one or more of the constant or tag sets as parameters to "use": use AppConfig qw(:expand :argcount); See "CONSTANT DEFINITIONS" below for more information on the constant tagsets defined by AppConfig. AppConfig is implemented using object-oriented methods. A new AppConfig object is created and initialised using the new() method. This returns a reference to a new AppConfig object. my $config = AppConfig->new(); This will create and return a reference to a new AppConfig object. In doing so, the AppConfig object also creates an internal reference to an AppConfig::State object in which to store variable state. All arguments passed into the AppConfig constructor are passed directly to the AppConfig::State constructor. The first (optional) parameter may be a reference to a hash array containing configuration information. my $config = AppConfig->new( { CASE => 1, ERROR => \&my_error, GLOBAL => { DEFAULT => "", ARGCOUNT => ARGCOUNT_ONE, }, } ); See AppConfig::State for full details of the configuration options available. These are, in brief: CASE Used to set case sensitivity for variable names (default: off). CREATE Used to indicate that undefined variables should be created automatically (default: off). GLOBAL Reference to a hash array of global values used by default when defining variables. Valid global values are DEFAULT, ARGCOUNT, EXPAND, VALIDATE and ACTION. PEDANTIC Used to indicate that command line and configuration file parsing routines should return immediately on encountering an error. ERROR Used to provide a error handling routine. Arguments as per printf(). Subsequent parameters may be variable definitions. These are passed to the define() method, described below in "DEFINING VARIABLES". my $config = AppConfig->new("foo", "bar", "baz"); my $config = AppConfig->new( { CASE => 1 }, qw(foo bar baz) ); Note that any unresolved method calls to AppConfig are automatically delegated to the AppConfig::State object. In practice, it means that it is possible to treat the AppConfig object as if it were an AppConfig::State object: # create AppConfig my $config = AppConfig->new('foo', 'bar'); # methods get passed through to internal AppConfig::State $config->foo(100); $config->set('bar', 200); $config->define('baz'); $config->baz(300); DEFINING VARIABLES The "define()" method (delegated to AppConfig::State) is used to pre-declare a variable and specify its configuration. $config->define("foo"); Variables may also be defined directly from the AppConfig new() constructor. my $config = AppConfig->new("foo"); In both simple examples above, a new variable called "foo" is defined. A reference to a hash array may also be passed to specify configuration information for the variable: $config->define("foo", { DEFAULT => 99, ALIAS => 'metavar1', }); Configuration items specified in the GLOBAL option to the module constructor are applied by default when variables are created. e.g. my $config = AppConfig->new( { GLOBAL => { DEFAULT => "", ARGCOUNT => ARGCOUNT_ONE, } } ); $config->define("foo"); $config->define("bar", { ARGCOUNT => ARGCOUNT_NONE } ); is equivalent to: my $config = AppConfig->new(); $config->define( "foo", { DEFAULT => "", ARGCOUNT => ARGCOUNT_ONE, } ); $config->define( "bar", DEFAULT => "", ARGCOUNT => ARGCOUNT_NONE, } ); Multiple variables may be defined in the same call to define(). Configuration hashes for variables can be omitted. $config->define("foo", "bar" => { ALIAS = "boozer" }, "baz"); See AppConfig::State for full details of the configuration options available when defining variables. These are, in brief: DEFAULT The default value for the variable (default: undef). ALIAS One or more (list reference or "list|like|this") alternative names for the variable. ARGCOUNT Specifies the number and type of arguments that the variable expects. Constants in ":expand" tag set define ARGCOUNT_NONE - simple on/off flag (default), ARGCOUNT_ONE - single value, ARGCOUNT_LIST - multiple values accessed via list reference, ARGCOUNT_HASH - hash table, "key=value", accessed via hash reference. ARGS Used to provide an argument specification string to pass to Getopt::Long via AppConfig::Getopt. E.g. "=i", ":s", "=s@". This can also be used to implicitly set the ARGCOUNT value ("/^!/" = ARGCOUNT_NONE, "/@/" = ARGCOUNT_LIST, "/%/" = ARGCOUNT_HASH, "/[=:].*/" = ARGCOUNT_ONE) EXPAND Specifies which variable expansion policies should be used when parsing configuration files. Constants in ":expand" tag set define: EXPAND_NONE - no expansion (default) EXPAND_VAR - expand C<$var> or C<$(var)> as other variables EXPAND_UID - expand C<~> and C<~uid> as user's home directory EXPAND_ENV - expand C<${var}> as environment variable EXPAND_ALL - do all expansions. VALIDATE Regex which the intended variable value should match or code reference which returns 1 to indicate successful validaton (variable may now be set). ACTION Code reference to be called whenever variable value changes. COMPACT FORMAT DEFINITION Variables can be specified using a compact format. This is identical to the specification format of Getopt::Long and is of the form: "name|alias|alias" The first element indicates the variable name and subsequent ALIAS values may be added, each separated by a vertical bar '|'. The element indicates the ARGCOUNT value and may be one of the following; ! ARGCOUNT_NONE =s ARGCOUNT_ONE =s@ ARGCOUNT_LIST =s% ARGCOUNT_HASH Additional constructs supported by Getopt::Long may be specified instead of the "=s" element (e.g. "=f"). The entire element is stored in the ARGS parameter for the variable and is passed intact to Getopt::Long when the getopt() method is called. The following examples demonstrate use of the comapct format, with their equivalent full specifications: $config->define("foo|bar|baz!"); $config->define( "foo" => { ALIAS => "bar|baz", ARGCOUNT => ARGCOUNT_NONE, }); $config->define("name=s"); $config->define( "name" => { ARGCOUNT => ARGCOUNT_ONE, }); $config->define("file|filelist|f=s@"); $config->define( "file" => { ALIAS => "filelist|f", ARGCOUNT => ARGCOUNT_LIST, }); $config->define("user|u=s%"); $config->define( "user" => { ALIAS => "u", ARGCOUNT => ARGCOUNT_HASH, }); Additional configuration options may be specified by hash reference, as per normal. The compact definition format will override any configuration values provided for ARGS and ARGCOUNT. $config->define("file|filelist|f=s@", { VALIDATE = \&check_file() } ); READING AND MODIFYING VARIABLE VALUES AppConfig defines two methods (via AppConfig::State) to manipulate variable values set($variable, $value); get($variable); Once defined, variables may be accessed directly as object methods where the method name is the same as the variable name. i.e. $config->set("verbose", 1); is equivalent to $config->verbose(1); Note that AppConfig defines the following methods: new(); file(); args(); getopt(); And also, through delegation to AppConfig::State: define() get() set() varlist() If you define a variable with one of the above names, you will not be able to access it directly as an object method. i.e. $config->file(); This will call the file() method, instead of returning the value of the 'file' variable. You can work around this by explicitly calling get() and set() on a variable whose name conflicts: $config->get('file'); or by defining a "safe" alias by which the variable can be accessed: $config->define("file", { ALIAS => "fileopt" }); or $config->define("file|fileopt"); ... $config->fileopt(); Without parameters, the current value of the variable is returned. If a parameter is specified, the variable is set to that value and the result of the set() operation is returned. $config->age(29); # sets 'age' to 29, returns 1 (ok) print $config->age(); # prints "29" The varlist() method can be used to extract a number of variables into a hash array. The first parameter should be a regular expression used for matching against the variable names. my %vars = $config->varlist("^file"); # all "file*" variables A second parameter may be specified (any true value) to indicate that the part of the variable name matching the regex should be removed when copied to the target hash. $config->file_name("/tmp/file"); $config->file_path("/foo:/bar:/baz"); my %vars = $config->varlist("^file_", 1); # %vars: # name => /tmp/file # path => "/foo:/bar:/baz" READING CONFIGURATION FILES The AppConfig module provides a streamlined interface for reading configuration files with the AppConfig::File module. The file() method automatically loads the AppConfig::File module and creates an object to process the configuration file or files. Variables stored in the internal AppConfig::State are automatically updated with values specified in the configuration file. $config->file($filename); Multiple files may be passed to file() and should indicate the file name or be a reference to an open file handle or glob. $config->file($filename, $filehandle, \*STDIN, ...); The file may contain blank lines and comments (prefixed by '#') which are ignored. Continutation lines may be marked by ending the line with a '\'. # this is a comment 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 (including any continuation lines). An optional 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 e="emacs" 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"; } 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 EXPANSION 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 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 PARSING COMMAND LINE OPTIONS There are two methods for processing command line options. The first, args(), is a small and efficient implementation which offers basic functionality. The second, getopt(), offers a more powerful and complete facility by delegating the task to Johan Vroman's Getopt::Long module. The trade-off between args() and getopt() is essentially one of speed/size against flexibility. Use as appropriate. Both implement on-demand loading of modules and incur no overhead until used. The args() method is used to parse simple command line options. It automatically loads the AppConfig::Args module and creates an object to process the command line arguments. Variables stored in the internal AppConfig::State are automatically updated with values specified in the arguments. The method should be passed a reference to a list of arguments to parse. The @ARGV array is used if args() is called without parameters. $config->args(\@myargs); $config->args(); # uses @ARGV Arguments are read and shifted from the array until the first is encountered that is not prefixed by '-' or '--'. At that point, the method returns 1 to indicate success, leaving any unprocessed arguments remaining in the list. Each argument should be the name or alias of a variable prefixed by '-' or '--'. Arguments that are not prefixed as such (and are not an additional parameter to a previous argument) will cause a warning to be raised. If the PEDANTIC option is set, the method will return 0 immediately. With PEDANTIC unset (default), the method will continue to parse the rest of the arguments, returning 0 when done. If the variable is a simple flag (ARGCOUNT = ARGCOUNT_NONE) then it is set to the value 1. The variable may be prefixed by "no" to set its value to 0. myprog -verbose --debug -notaste # $config->verbose(1) # $config->debug(1) # $config->taste(0) Variables that expect an additional argument (ARGCOUNT != 0) will be set to the value of the argument following it. myprog -f /tmp/myfile # $config->file('/tmp/file'); Variables that expect multiple values (ARGCOUNT = ARGCOUNT_LIST or ARGCOUNT_HASH) will have sucessive values added each time the option is encountered. myprog -file /tmp/foo -file /tmp/bar # $config->file('/tmp/foo') # $config->file('/tmp/bar') # file => [ '/tmp/foo', '/tmp/bar' ] myprog -door "jim=Jim Morrison" -door "ray=Ray Manzarek" # $config->door("jim=Jim Morrison"); # $config->door("ray=Ray Manzarek"); # door => { 'jim' => 'Jim Morrison', 'ray' => 'Ray Manzarek' } See AppConfig::Args for further details on parsing command line arguments. The getopt() method provides a way to use the power and flexibility of the Getopt::Long module to parse command line arguments and have the internal values of the AppConfig object updates automatically. The first (non-list reference) parameters may contain a number of configuration string to pass to Getopt::Long::Configure. A reference to a list of arguments may additionally be passed or @ARGV is used by default. $config->getopt(); # uses @ARGV $config->getopt(\@myargs); $config->getopt(qw(auto_abbrev debug)); # uses @ARGV $config->getopt(qw(debug), \@myargs); See Getopt::Long for details of the configuration options available. The getopt() method constructs a specification string for each internal variable and then initialises Getopt::Long with these values. The specification string is constructed from the name, any aliases (delimited by a vertical bar '|') and the value of the ARGS parameter. $config->define("foo", { ARGS => "=i", ALIAS => "bar|baz", }); # Getopt::Long specification: "foo|bar|baz=i" Errors and warning generated by the Getopt::Long module are trapped and handled by the AppConfig error handler. This may be a user-defined routine installed with the ERROR configuration option. Please note that the AppConfig::Getopt interface is still experimental and may not be 100% operational. This is almost undoubtedly due to problems in AppConfig::Getopt rather than Getopt::Long. PARSING CGI PARAMETERS The cgi() method provides an interface to the AppConfig::CGI module for updating variable values based on the parameters appended to the URL for a CGI script. This is commonly known as the CGI "GET" method. The CGI "POST" method is currently not supported. Parameter definitions are separated from the CGI script name by a question mark and from each other by ampersands. Where variables have specific values, these are appended to the variable with an equals sign: http://www.here.com/cgi-bin/myscript?foo=bar&baz=qux&verbose # $config->foo('bar'); # $config->baz('qux'); # $config->verbose(1); Certain values specified in a URL must be escaped in the appropriate manner (see CGI specifications at http://www.w3c.org/ for full details). The AppConfig::CGI module automatically unescapes the CGI query string to restore the parameters to their intended values. http://where.com/mycgi?title=%22The+Wrong+Trousers%22 # $config->title('"The Wrong Trousers"'); Please be considerate of the security implications of providing writeable access to script variables via CGI. http://rebel.alliance.com/cgi-bin/... .../send_report?file=%2Fetc%2Fpasswd&email=darth%40empire.com To avoid any accidental or malicious changing of "private" variables, define only the "public" variables before calling the cgi() (or any other) method. Further variables can subequently be defined which can not be influenced by the CGI parameters. $config->define('verbose', 'debug') $config->cgi(); # can only set verbose and debug $config->define('email', 'file'); $config->file($cfgfile); # can set verbose, debug, email + file CONSTANT DEFINITIONS A number of constants are defined by the AppConfig module. These may be accessed directly (e.g. AppConfig::EXPAND_VARS) or by first importing them into the caller's package. Constants are imported by specifying their names as arguments to "use AppConfig" or by importing a set of constants identified by its "tag set" name. use AppConfig qw(ARGCOUNT_NONE ARGCOUNT_ONE); use AppConfig qw(:argcount); The following tag sets are defined: :expand The ':expand' tagset defines the following constants: EXPAND_NONE EXPAND_VAR EXPAND_UID EXPAND_ENV EXPAND_ALL # EXPAND_VAR | EXPAND_UID | EXPAND_ENV EXPAND_WARN See AppConfig::File for full details of the use of these constants. :argcount The ':argcount' tagset defines the following constants: ARGCOUNT_NONE ARGCOUNT_ONE ARGCOUNT_LIST ARGCOUNT_HASH See AppConfig::State for full details of the use of these constants. AUTHOR Andy Wardley, With contributions from Dave Viner, Ijon Tichy, Axel Gerstmair and many others whose names have been lost to the sands of time (reminders welcome). 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. SEE ALSO AppConfig::State, AppConfig::File, AppConfig::Args, AppConfig::Getopt, AppConfig::CGI, Getopt::Long appconfig-1.66.orig/t/0000755000000000000000000000000010643431405011504 5ustar appconfig-1.66.orig/t/99_author.t0000644000000000000000000000275510643427374013537 0ustar #!/usr/bin/perl -w use strict; BEGIN { $| = 1; $^W = 1; } use Test::More; # Skip if doing a regular install unless ( $ENV{AUTOMATED_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Can we run the POD tests? eval "use Test::Pod 1.00"; if ( $@ ) { plan( skip_all => "Test::Pod 1.00 required for testing POD" ); } ##################################################################### # WARNING: INSANE BLACK MAGIC ##################################################################### # Hack Pod::Simple::BlackBox to ignore the Test::Inline # "Extended Begin" syntax. # For example, "=begin has more than one word errors" my $begin = \&Pod::Simple::BlackBox::_ponder_begin; sub mybegin { my $para = $_[1]; my $content = join ' ', splice @$para, 2; $content =~ s/^\s+//s; $content =~ s/\s+$//s; my @words = split /\s+/, $content; if ( $words[0] =~ /^test(?:ing)?\z/s ) { foreach ( 2 .. $#$para ) { $para->[$_] = ''; } $para->[2] = $words[0]; } # Continue as normal push @$para, @words; return &$begin(@_); } SCOPE: { local $^W = 0; *Pod::Simple::BlackBox::_ponder_begin = \&mybegin; } ##################################################################### # END BLACK MAGIC ##################################################################### # Test POD all_pod_files_ok(); appconfig-1.66.orig/t/appconfig.t0000644000000000000000000000353610643426045013652 0ustar #!/usr/bin/perl -w #======================================================================== # # t/appconfig.t # # AppConfig test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..9\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); $loaded = 1; ok(1); #------------------------------------------------------------------------ # define a new AppConfig object # my $default = ""; my $anon = ""; my $noage = ""; my $config = AppConfig->new({ GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_ONE, } }, 'verbose', { DEFAULT => 0, ARGCOUNT => ARGCOUNT_NONE, }, 'user', { ALIAS => 'name|uid', DEFAULT => $anon, }); $config->define( 'age', { DEFAULT => $noage, VALIDATE => '\d+', }); #------------------------------------------------------------------------ # check and manipulate variables # #2: check config got defined ok( defined $config ); #3 - #5: check variables were defined ok( $config->verbose() == 0 ); ok( $config->user() eq $anon ); ok( $config->age() eq $noage ); #6: read config file at DATA handle ok( $config->file(\*DATA) ); #7 - #9: check values got updated correctly ok( $config->verbose() == 1 ); ok( $config->user() eq 'abw' ); ok( $config->age() == 42 ); __DATA__ verbose = 1 user = abw age = 42 appconfig-1.66.orig/t/args.t0000644000000000000000000000450410643426066012637 0ustar #!/usr/bin/perl -w #======================================================================== # # t/args.t # # AppConfig::Args test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #------------------------------------------------------------------------ # TODO # * test PEDANTIC option # #======================================================================== use lib qw( ../lib ./lib ); use strict; use vars qw($loaded); use AppConfig qw(:argcount); use AppConfig::Args; use Test::More tests => 17; ok(1, 'loaded'); #------------------------------------------------------------------------ # create new AppConfig::State and AppConfig::Args objects #------------------------------------------------------------------------ my $default = ""; my $anon = ""; my $user = "Fred Smith"; my $age = 42; my $notarg = "This is not an arg"; my $state = AppConfig::State->new({ GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_ONE, } }, 'verbose' => { DEFAULT => 0, ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'v', }, 'user' => { ALIAS => 'u|name|uid', DEFAULT => $anon, }, 'age' => { ALIAS => 'a', VALIDATE => '\d+', }); my $cfgargs = AppConfig::Args->new($state); ok( defined $state, 'defined state' ); ok( defined $cfgargs, 'defined cfgargs' ); my @args = ('-v', '-u', $user, '-age', $age, $notarg); ok( $cfgargs->parse(\@args), 'parse' ); is( $state->verbose(), 1, 'verbose' ); is( $state->user(), $user, 'user' ); is( $state->age(), $age, 'age' ); is( $args[0], $notarg, 'next arg' ); @ARGV = ('--age', $age * 2, $notarg); ok( $cfgargs->parse(), 'second parse' ); is( $state->age(), $age * 2, 'second age' ); is( $ARGV[0], $notarg, 'second next arg' ); @ARGV = ('--user=Andy_Wardley', '--age=30'); ok( $cfgargs->parse(), 'third parse' ); is( $state->age(), 30, 'third age' ); is( $state->user(), 'Andy_Wardley', 'third user' ); @ARGV = ('--user', 'Me Again', '--age', '34'); ok( $cfgargs->parse(), 'fourth parse' ); is( $state->age(), 34, 'fourth age' ); is( $state->user(), 'Me Again', 'fourth user' ); appconfig-1.66.orig/t/block.t0000644000000000000000000000421710643426535012777 0ustar #!/usr/bin/perl -w #======================================================================== # # t/block.t # # AppConfig::File test file. Tests [block] definitions in config files. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); use AppConfig qw(:expand :argcount); use AppConfig::File; use Test::More tests => 7; #------------------------------------------------------------------------ # create new AppConfig::State and AppConfig::File objects my $state = AppConfig::State->new( { GLOBAL => { ARGCOUNT => ARGCOUNT_ONE, }, }, 'foo', 'bar', 'dir_home', { EXPAND => EXPAND_ENV, }, 'dir_html', { EXPAND => EXPAND_ENV, }, ); # $state->_debug(1); my $cfgfile = AppConfig::File->new($state); # $state->_debug(0); #2 - #3: test that state and cfgfile got instantiated correctly ok( defined $state, 'defined state' ); ok( defined $cfgfile, 'defined cfgfile' ); #4: read the config file (from __DATA__) ok( $cfgfile->parse(\*DATA), 'parsed config' ); #5 - #6: test simple variable values got set correctly ok( $state->foo eq 'This is foo', 'foo is set' ); ok( $state->bar eq 'This is bar', 'bar is set' ); #7 - #8: test [dir] block variables got set correctly SKIP: { skip 'No HOME environment variable set', 2 unless $ENV{ HOME }; ok( $state->dir_home eq $ENV{HOME}, 'matched HOME'); ok( $state->dir_html eq ($ENV{HOME} . '/public_html'), 'matched HTML' ); } #======================================================================== # the rest of the file comprises the sample configuration information # that gets read by parse() # __DATA__ # lines starting with '#' are regarded as comments and are ignored foo = This is foo bar = This is bar [dir] home = ${HOME} html = ${HOME}/public_html appconfig-1.66.orig/t/cgi.t0000644000000000000000000000370110643426570012443 0ustar #!/usr/bin/perl -w #======================================================================== # # t/cgi.t # # AppConfig::CGI test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..9\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); use AppConfig::CGI; $loaded = 1; ok(1); #------------------------------------------------------------------------ # create new AppConfig::State and AppConfig::CGI objects # my $default = ""; my $anon = ""; my $user = "Fred Smith"; my $age = 42; my $notarg = "This is not an arg"; my $state = AppConfig::State->new({ GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_ONE, } }, 'verbose' => { DEFAULT => 0, ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'v', }, 'user' => { ALIAS => 'u|name|uid', DEFAULT => $anon, }, 'age' => { ALIAS => 'a', VALIDATE => '\d+', }); my $cfgcgi = AppConfig::CGI->new($state); #2 - #3: test the state and cfgargs got instantiated correctly ok( defined $state ); ok( defined $cfgcgi ); my $args = "v&u=$user&age=$age"; #4: process the args ok( $cfgcgi->parse($args) ); #5 - #7: check variables got updated ok( $state->verbose() == 1 ); ok( $state->user() eq $user ); ok( $state->age() == $age ); $age = $age * 2; #8 - #9: check args defaults to using $ENV{ QUERY_STRING } $ENV{ QUERY_STRING } = "v&u=$user=$user&age=$age"; ok( $cfgcgi->parse() ); ok( $state->age() == $age ); appconfig-1.66.orig/t/compact.t0000644000000000000000000000602310643426557013334 0ustar #!/usr/bin/perl -w #======================================================================== # # t/compact.t # # AppConfig test file validating the use of the compact definition format. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..19\n"; $" = ', '; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); $loaded = 1; ok(1); #------------------------------------------------------------------------ # create new AppConfig # my $default = ""; my $anon = ""; my $user = "Fred Smith"; my $age = 42; my $notarg = "This is not an arg"; my $file1 = 'File_Number_One'; my $file2 = 'File_Number_Two'; my %define = ( 'first' => 'first hash value', 'next' => 'next hash value', 'last' => 'last hash value', ); my $config = AppConfig->new({ ERROR => sub { my $format = "ERR: " . shift() . "\n"; printf STDERR $format, @_; }, GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_ONE, } }, 'verbose|v!', 'filelist|file|f=s@', 'user|u|name|uid=s', 'define|defvar' => { ARGS => "=s%" }, 'multi' => { ARGCOUNT => ARGCOUNT_LIST, }, 'age|a' => { VALIDATE => '\d+', # NOTE: Getopt::Long args # constructed automatically }); #2: test the AppConfig got instantiated correctly ok( defined $config ); my @defargs = map { ( "--define", "\"$_=$define{ $_ }\"" ) } keys %define; my @args = ('-v', '-u', $user, '--age', $age, '--file', $file1, '-f', $file2, @defargs, '-multi', 1, '--multi', 2, '-m', 3, $notarg); #3: process the args # $config->_debug(1); ok( $config->getopt(qw(default auto_abbrev), \@args) ); # $config->_debug(0); #4 - #6: check variables got updated ok( $config->verbose() == 1 ); ok( $config->user() eq $user ); ok( $config->age() eq $age ); #7 - #10: check list variable (file) got set my $files; ok( defined ($files = $config->filelist()) ); ok( scalar @$files == 2 ); ok ($files->[0] eq $file1 ); ok ($files->[1] eq $file2 ); #11 - #15: check list variable (multi) got set my $multi; ok( defined ($multi = $config->multi()) ); ok( scalar @$multi == 3 ); foreach my $i (1..3) { ok ($multi->[$i - 1] == $i ); } #16: next arg should be $notarg ok( $args[0] = $notarg ); #17 - #19: check args defaults to using @ARGV @ARGV = ('--age', $age * 2, $notarg); ok( $config->getopt() ); ok( $config->age() == ($age * 2) ); ok( $ARGV[0] eq $notarg ); appconfig-1.66.orig/t/const.t0000644000000000000000000000235110643426743013031 0ustar #!/usr/bin/perl -w #======================================================================== # # t/const.t # # AppConfig::Const test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); use Test::More tests => 9; use AppConfig ':expand'; ok(1, 'loaded'); #------------------------------------------------------------------------ #2 - #5: test that the EXPAND_XXX constants got imported # ok( EXPAND_UID, 'EXPAND_UID' ); ok( EXPAND_VAR, 'EXPAND_VAR' ); ok( EXPAND_ENV, 'EXPAND_ENV' ); ok( EXPAND_ALL == EXPAND_UID | EXPAND_VAR | EXPAND_ENV, 'EXPAND_ALL' ); #------------------------------------------------------------------------ #6 - #9: test that the EXPAND_XXX package vars are defined # ok( AppConfig::EXPAND_UID, 'EXPAND_UID' ); ok( AppConfig::EXPAND_VAR, 'EXPAND_VAR' ); ok( AppConfig::EXPAND_ENV, 'EXPAND_ENV' ); ok( AppConfig::EXPAND_ALL == AppConfig::EXPAND_UID | AppConfig::EXPAND_VAR | AppConfig::EXPAND_ENV, 'EXPAND_ALL' ); appconfig-1.66.orig/t/default.t0000644000000000000000000000531510643427203013322 0ustar #!/usr/bin/perl -w #======================================================================== # # t/default.t # # AppConfig::File test file. Tests the '-option' syntax which is used # to reset variables to their default values. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); use lib qw( ../lib ./lib ); use Test::More tests => 19; use AppConfig qw(:expand :argcount); ok(1, 'loaded'); #------------------------------------------------------------------------ # create new AppConfig # my $BAZDEF = "all_bar_none"; my $BAZNEW = "new_bar"; my $config = AppConfig->new( { GLOBAL => { ARGCOUNT => 0 } }, 'foo', 'bar', 'baz' => { ARGCOUNT => 1, DEFAULT => $BAZDEF }, 'qux' => { ARGCOUNT => 1 }, 'list' => { ARGCOUNT => ARGCOUNT_LIST, DEFAULT => [ 2, 3, 5, 7, 9 ], }, 'hash' => { ARGCOUNT => ARGCOUNT_HASH, DEFAULT => { two => 2, three => 3, five => 5 }, }, ); #2: test config got instantiated correctly ok( defined $config, 'defined config' ); #3 - #4: set some dummy values ok( $config->foo(1), 'got foo' ); ok( $config->baz($BAZNEW), 'baz new'); #5 - #6: test them ok( $config->foo() == 1, 'foo set' ); ok( $config->baz() eq $BAZNEW, 'baz set' ); #------------------------------------------------------------------------ # list #------------------------------------------------------------------------ my $list = $config->list(); ok( $list, 'got default list' ); ok( $list->[0] == 2, 'first item two' ); ok( $list->[2] == 5, 'third item five' ); #------------------------------------------------------------------------ # hash #------------------------------------------------------------------------ my $hash = $config->hash(); ok( $hash, 'got default hash' ); ok( $hash->{ two } == 2, 'item two' ); ok( $hash->{ five } == 5, 'item five' ); #7: read the config from __DATA__ ok( $config->file(\*DATA), 'read from file' ); #8 - #9: test foo and baz got reset to defaults correctly ok( $config->foo() == 0, 'foo set to zero' ); ok( $config->baz() eq $BAZDEF, 'baz def stuff' ); #10 - #11: test that "+bar" and "+qux" worked ok( $config->bar() == 1, 'bar is one' ); ok( $config->qux() eq '1', 'qux is one' ); #12 - #15: test that list and hash are set ok( $config->bar() == 1, 'bar still one' ); ok( $config->qux() eq '1', 'qux still one' ); __DATA__ -foo +bar -baz +qux appconfig-1.66.orig/t/file.t0000644000000000000000000002004410643427006012612 0ustar #!/usr/bin/perl -w #======================================================================== # # t/file.t # # AppConfig::File test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #------------------------------------------------------------------------ # # TODO # # * test PEDANTIC option # # * test EXPAND_WARN option # #======================================================================== use strict; use vars qw($loaded); use lib qw( ../lib ./lib ); use Test::More tests => 43; use AppConfig qw(:expand :argcount); use AppConfig::File; ok(1); #------------------------------------------------------------------------ # create new AppConfig::State and AppConfig::File objects #------------------------------------------------------------------------ my $state = AppConfig::State->new({ CREATE => '^(?:define|here)_', GLOBAL => { EXPAND => EXPAND_ALL, ARGCOUNT => ARGCOUNT_ONE, }, }, 'html', 'same', 'split', 'title', 'ident', 'cash' => { EXPAND => EXPAND_NONE }, # ignore '$' in cash 'hdir' => { EXPAND => EXPAND_VAR }, # expand only $vars 'verbose' => { ARGCOUNT => ARGCOUNT_NONE }, # simple flags.. 'cruft' => { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1, }, 'debug' => { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1, }, 'chance' => { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1, }, 'hope' => { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1, }, 'drink' => { ARGCOUNT => ARGCOUNT_LIST, }, 'name' => { ARGCOUNT => ARGCOUNT_HASH, }, 'here_empty' => { ARGCOUNT => ARGCOUNT_NONE, }, 'here_hash' => { ARGCOUNT => ARGCOUNT_HASH, }, ); # turn debugging on to trigger debugging in $cfgfile # $state->_debug(1); my $cfgfile = AppConfig::File->new($state); # AppConfig::State can be turned off, AppConfig::File debugging remains on. # $state->_debug(0); ok( defined $state, 'state defined' ); ok( defined $cfgfile, 'cfgfile defined' ); ok( $cfgfile->parse(\*DATA), 'parsed' ); #------------------------------------------------------------------------ # test variable values got set with correct expansion #------------------------------------------------------------------------ # html has no embedded variables ok( $state->html() eq 'public_html' ); # cash should *not* be expanded (EXPAND_NONE) to protect '$' ok( $state->cash() eq 'I won $200!' ); SKIP: { skip("User does not have a home directory", 2) unless defined $ENV{HOME}; # hdir expands variables ($html) but not uids (~) ok( $state->hdir() eq '~/public_html' ); # see if "[~/$html]" matches "[${HOME}/$html]". It may fail if your # platform doesn't provide getpwuid(). See AppConfig::Sys for details. my ($one, $two) = $state->same() =~ / \[ ( [^\]]+ ) \] \s+=>\s+ \[ ( [^\]]+ ) \]/gx; is( $one, $two, 'one is two' ); } # test that "split" came out the same as "same" is( $state->same(), $state->split(), 'same split' ); # test that "verbose" got set to 1 when no parameter was provided is( $state->verbose(), 1, 'verbose' ); # test that debug got turned off by explicit (debug = 0) ok( ! $state->debug(), 'not debuggin' ); # test that cruft got turned off by "nocruft" ok( ! $state->cruft(), 'not crufty' ); ok( $state->nocruft(), 'nocruft' ); # test that chance got turned on by "nochance = 0" ok( $state->chance(), 'there is a chance' ); ok( ! $state->nochance(), 'there is not no chance' ); # test that hope got turned on by "nohope = off" ok( $state->hope(), 'there is hope' ); ok( ! $state->nohope(), 'there is not no hope' ); # check auto-creation of variables and variable expansion of # [block] variable is( $state->define_user(), 'abw', 'user is abw'); is( $state->define_home(), '/home/abw', 'home is /home/abw' ); is( $state->define_chez(), '/chez/abw', 'chez is /chez/abw' ); is( $state->define_choz(), 'foo#bar', 'choz is set' ); is( $state->define_chuz(), '^#', 'chuz is set' ); #21 - #22: test $state->varlist() without strip option my (%set, $expect, $got); %set = $state->varlist('^define_'); $expect = 'define_chaz=/$chez/#chaz, define_chez=/chez/abw, define_choz=foo#bar, define_chuz=^#, define_home=/home/abw, define_user=abw'; $got = join(', ', map { "$_=$set{$_}" } sort keys %set); is( scalar keys %set, 6, 'five keys' ); is( $expect, $got, 'varlist' ); #23 - #24: test $state->varlist() with strip option %set = $state->varlist('^define_', 1); $expect = 'chaz=/$chez/#chaz, chez=/chez/abw, choz=foo#bar, chuz=^#, home=/home/abw, user=abw'; $got = join(', ', map { "$_=$set{$_}" } sort keys %set); is( scalar keys %set, 6, 'five stripped keys'); is( $expect, $got, 'stripped varlist' ); #25 - #27: test ARGCOUNT_LIST my $drink = $state->drink(); is( $drink->[0], 'coffee', 'coffee'); is( $drink->[1], 'beer', 'beer'); is( $drink->[2], 'water', 'water'); #28 - #31: test ARGCOUNT_HASH my $name = $state->name(); my $crew = join(", ", sort keys %$name); ok( $crew eq "abw, mim, mrp" ); ok( $name->{'abw'} eq 'Andy' ); ok( $name->{'mrp'} eq 'Martin' ); ok( $name->{'mim'} eq 'Man in the Moon' ); #32 - #33: test quoting ok( $state->title eq "Lord of the Rings"); ok( $state->ident eq "Keeper of the Scrolls"); # test \$ and \# suppression is( $state->define_chaz(), '/$chez/#chaz', 'chaz defined' ); # test whitespace required before '#' is( $state->define_choz(), 'foo#bar', 'choz defined' ); is( $state->define_chuz(), '^#', 'chuz defined' ); #39 - #42: test here-doc ok( ! $state->here_empty(), 'empty here-doc'); is( $state->here_linebreaks(), <here_quote(), '<here_eof(), "parse() reads to eof if the boundary string is absent.\n", 'heredoc with EOF'); is_deeply( $state->here_hash(), { 'key1' => 'value 1', 'key2' => 'value 2', 'key3' => "multi-line\nvalue 3", '"key 4"' => "< [${HOME}/$html] verbose debug = 0 nocruft # this next one should turn chance ON (equivalent to "chance = 1") nochance = 0 nohope = off # the next line has a continutation, but should be treated the same split = [~/$html] => \ [${HOME}/$html] # test list definitions drink coffee drink beer drink water # test hash definitions name abw = Andy name mrp = Martin name = mim = "Man in the Moon" # test quoting title = "Lord of the Rings" ident = 'Keeper of the Scrolls' [define] user = abw # this is a comment home = /home/$user chez = /chez/$define_user chaz = /\$chez/\#chaz # this is also a comment choz = foo#bar # this is a comment, but the '# bar' part wasn't chuz = ^# # so is this, nor was that [here] empty = < # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #------------------------------------------------------------------------ # # TODO # # * test PEDANTIC option # # * test EXPAND_WARN option # #======================================================================== use strict; use vars qw($loaded @expect); BEGIN { # what we expect the debug state(s) to be @expect = qw(1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0); my $max = 3 + @expect; $| = 1; print "1..$max\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:expand :argcount); $loaded = 1; ok(1); #------------------------------------------------------------------------ # define storage and callback for keeping track of the state of 'debug' # variable as it changes. # my @debug; # callback routine to store the state of 'debug' each time it changes sub debug_set { my $cfg = shift; my $var = shift; my $val = shift; push(@debug, $val); 1; } #------------------------------------------------------------------------ # create new AppConfig object # my $config = AppConfig->new('debug', { ACTION => \&debug_set }); #2: test config got instantiated correctly ok( defined $config ); #3: read the config file (from __DATA__) ok( $config->file(\*DATA) ); while (@expect) { my $e = shift @expect; my $d = shift @debug; ok( $e == $d ); } #======================================================================== # the rest of the file comprises the sample configuration information # that gets read by file() # __DATA__ debug debug 0 debug 1 debug = 0 debug = 1 debug off debug on debug Off debug On debug OFF debug ON debug = off debug = on debug is very much turned on debug = a turned on thing nodebug appconfig-1.66.orig/t/getopt.t0000644000000000000000000000423310627254543013205 0ustar #!/usr/bin/perl -w #======================================================================== # # t/getopt.t # # AppConfig::Getopt test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..10\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); $loaded = 1; ok(1); #------------------------------------------------------------------------ # create new AppConfig # my $default = ""; my $anon = ""; my $user = "Fred Smith"; my $age = 42; my $notarg = "This is not an arg"; my $config = AppConfig->new({ # DEBUG => 1, ERROR => sub { my $format = "ERR: " . shift() . "\n"; printf STDERR $format, @_; }, GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_ONE, } }, 'verbose' => { DEFAULT => 0, ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'v', }, 'user' => { ALIAS => 'u|name|uid', ARGS => '=s', # explicit Getopt::Long args DEFAULT => $anon, }, 'age' => { ALIAS => 'a', VALIDATE => '\d+', # NOTE: Getopt::Long args # constructed automatically }); #2: test the AppConfig got instantiated correctly ok( defined $config ); my @args = ('-v', '-u', $user, '--age', $age, $notarg); #3: process the args # $config->_debug(1); ok( $config->getopt(qw(default auto_abbrev), \@args) ); # $config->_debug(0); #4 - #6: check variables got updated ok( $config->verbose() == 1 ); ok( $config->user() eq $user ); ok( $config->age() eq $age ); #7: next arg should be $notarg ok( $args[0] = $notarg ); #8 - #10: check args defaults to using @ARGV @ARGV = ('--age', $age * 2, $notarg); ok( $config->getopt() ); ok( $config->age() == ($age * 2) ); ok( $ARGV[0] eq $notarg ); appconfig-1.66.orig/t/multi.t0000644000000000000000000000575610627254543013050 0ustar #!/usr/bin/perl -w #======================================================================== # # t/multi.t # # AppConfig::State test file for multiple options (list, hash) # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..27\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); use AppConfig::State; $loaded = 1; ok(1); #------------------------------------------------------------------------ # define variables and handler subs # my $default = ""; my $none = ""; my $user1 = 'foo'; my $user2 = 'bar'; my $user3 = 'baz'; my $var1 = "age=29"; my $var2 = "sex=male"; my $var3 = "eyes=blue"; #------------------------------------------------------------------------ # define a new AppConfig::State object # my $state = AppConfig::State->new({ GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_NONE, }, }, 'verbose', { DEFAULT => 0, }, 'user', { ARGCOUNT => ARGCOUNT_LIST, }, 'var', { ARGCOUNT => ARGCOUNT_HASH, }); #------------------------------------------------------------------------ # check and manipulate variables # #2: check state got defined ok( defined $state ); #3 - #5: check default values ok( $state->verbose() == 0 ); ok( ref($state->user()) eq 'ARRAY' ); ok( ref($state->var()) eq 'HASH' ); #6 - #8: check ARGCOUNT got set explicitly or by default ok( $state->_argcount('verbose') == ARGCOUNT_NONE ); ok( $state->_argcount('user') == ARGCOUNT_LIST ); ok( $state->_argcount('var') == ARGCOUNT_HASH ); #9 - #10: set verbose value and check ok( $state->verbose(1) ); ok( $state->verbose() == 1 ); #11 - #13: set multiple user values ok( $state->user($user1) ); ok( $state->user($user2) ); ok( $state->user($user3) ); #14 - 15: check user values were set my $userlist = $state->user(); ok( ref($userlist) eq 'ARRAY' ); ok( $userlist->[0] eq $user1 && $userlist->[1] eq $user2 && $userlist->[2] eq $user3 ); #16 - #18: set hash var values ok( $state->var($var1) ); ok( $state->var($var2) ); ok( $state->var($var3) ); #19 - #22: check var hash value were set my $varhash = $state->var(); ok( ref($varhash) eq 'HASH' ); ok( $varhash->{'age'} == 29 ); ok( $varhash->{'sex'} eq 'male' ); ok( $varhash->{'eyes'} eq 'blue' ); #23 - #25 : reset values to defaults ok( $state->_default('verbose') eq 0 ); ok( ref($state->_default('user')) eq 'ARRAY' ); ok( ref($state->_default('var')) eq 'HASH' ); #26 - #27: check default ARRAY/HASH are empty ok( scalar @{ $state->user() } == 0 ); ok( scalar %{ $state->var() } == 0 ); appconfig-1.66.orig/t/novars.t0000644000000000000000000000426710627254543013222 0ustar #!/usr/bin/perl -w #======================================================================== # # t/novars.t # # AppConfig::State test file testing negative setting of flag options # with "no" syntax. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #------------------------------------------------------------------------ # # TODO # # * test PEDANTIC option # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..18\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); use AppConfig::State; $loaded = 1; ok(1); #------------------------------------------------------------------------ # create new AppConfig::State and AppConfig::Args objects # my $state = AppConfig::State->new( 'verbose' => { DEFAULT => 0, ARGCOUNT => ARGCOUNT_NONE, ALIAS => 'v', }, 'debug' => { ALIAS => 'dbg|d', # should default ARGCOUNT to ARGCOUNT_NONE }, 'age' => { ALIAS => 'a', ARGCOUNT => ARGCOUNT_ONE, }, 'nohope', ); #2: test the state got instantiated correctly ok( defined $state ); #3 - #6: update and check verbose ok( $state->verbose(1) ); ok( $state->verbose() == 1 ); ok( $state->noverbose(1) ); ok( $state->verbose() == 0 ); #7 - #15: update and check debug, also using aliases ok( $state->debug(1) ); ok( $state->debug() == 1 ); ok( $state->nodebug(1) ); ok( $state->debug() != 1 ); ok( $state->dbg(1) ); ok( $state->dbg() == 1 ); ok( $state->nodbg(1) ); ok( ! $state->dbg() ); ok( $state->nodbg() ); #16 - #17: attempt to update nohope and check it doesn't get interpreted # as "no - hope" ok( $state->nohope(1) ); ok( $state->nohope() == 1 ); #18: attempt to update noage which should fail because it doesn't # have an ARGCOUNT of ARGCOUNT_NONE $state->_ehandler( sub { } ); # disable errors ok( ! $state->noage(1) ); appconfig-1.66.orig/t/state.t0000644000000000000000000001132210627254543013020 0ustar #!/usr/bin/perl -w #======================================================================== # # t/state.t # # AppConfig::State test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); BEGIN { $| = 1; print "1..45\n"; } END { ok(0) unless $loaded; } my $ok_count = 1; sub ok { shift or print "not "; print "ok $ok_count\n"; ++$ok_count; } use AppConfig qw(:argcount); use AppConfig::State; $loaded = 1; ok(1); #------------------------------------------------------------------------ # define variables and handler subs # my $default = ""; my $none = ""; my $user = 'abw'; my $age = 29; my $verbose = 0; my $errors = 0; # user validation routine sub check_user { my $var = shift; my $val = shift; return ($val eq $user); } # verbose action routine sub verbose { my $state = shift; my $var = shift; my $val = shift; # set global $verbose so we can test that this sub was called $verbose = $val; # ok return 1; } sub error { my $format = shift; my @args = @_; $errors++; } #------------------------------------------------------------------------ # define a new AppConfig::State object # my $state = AppConfig::State->new({ ERROR => \&error, GLOBAL => { DEFAULT => $default, ARGCOUNT => ARGCOUNT_ONE, }, }, 'verbose', { DEFAULT => 0, ACTION => \&verbose, ARGCOUNT => ARGCOUNT_NONE, }, 'user', { ALIAS => 'name|uid', VALIDATE => \&check_user, DEFAULT => $none, }, 'age', { VALIDATE => '\d+', }); # $state->_dump(); #------------------------------------------------------------------------ # check and manipulate variables # #2: check state got defined ok( defined $state ); #3 - #5: check default values ok( $state->verbose() == 0 ); ok( $state->user() eq $none ); ok( $state->age() eq $default ); #6 - #8: check ARGCOUNT got set explicitly or by default ok( $state->_argcount('verbose') == 0 ); ok( $state->_argcount('user') == 1 ); ok( $state->_argcount('age') == 1 ); #9 - #11: set values ok( $state->verbose(1) ); ok( $state->user($user) ); ok( $state->age($age) ); #12 - #14: read them back to check values got set correctly ok( $state->verbose() == 1 ); ok( $state->user() eq $user ); ok( $state->age() == $age ); #15: test that the verbose ACTION was called and $verbose set ok( $verbose == 1 ); #16 - #19: test the VALIDATE patterns/subs by attempting to set invalid values ok( ! $state->age('old') ); ok( $state->age() == $age ); ok( ! $state->user('dud') ); ok( $state->user() eq $user ); #20: check that the error handler correctly updated $errors ok( $errors == 2 ); #21 - #22: access variables via alias ok( $state->name() eq $user ); ok( $state->uid() eq $user ); #23 - #25: test case insensitivity ok( $state->USER() eq $user ); ok( $state->NAME() eq $user ); ok( $state->UID() eq $user ); #26 - #27: explicitly test get() and set() methods ok( $state->set('verbose', 100) ); ok( $state->get('verbose') == 100 ); #------------------------------------------------------------------------ # define a different AppConfig::State object # my $newstate = AppConfig::State->new({ CASE => 1, CREATE => '^define_', PEDANTIC => 1, ERROR => \&error, }); #28: check state got defined ok( defined $newstate ); #29 - #30: test CASE sensitivity $errors = 0; ok( ! $newstate->Foo() ); ok( $errors ); #31 - #32: test PEDANTIC mode is/isn't set in states ok( ! $state->_pedantic() ); ok( $newstate->_pedantic() ); #33 - #34: test auto-creation of define_ variable ok( $newstate->define_user($user) ); ok( $newstate->define_user() eq $user ); #------------------------------------------------------------------------ # define a third AppConfig::State object to test compact format # my $thirdstate = AppConfig::State->new("foo|bar|baz=s"); #35: check state got defined ok( defined $thirdstate ); $thirdstate->define("tom|dick|harry=i@"); $thirdstate->define("red|green|blue=s"); #36 - #42: check set()/get() for foo and aliases ok( $thirdstate->foo(5) ); ok( $thirdstate->foo() == 5 ); ok( $thirdstate->bar(6) ); ok( $thirdstate->bar() == 6 ); ok( $thirdstate->baz(7) ); ok( $thirdstate->baz() == 7 ); ok( $thirdstate->foo() == 7 ); #43 - #45: check ARGCOUNT for all vars ok( $thirdstate->_args('foo') eq '=s' ); ok( $thirdstate->_args('tom') eq '=i@' ); ok( $thirdstate->_args('red') eq '=s' ); appconfig-1.66.orig/t/sys.t0000644000000000000000000000327010627254543012521 0ustar #!/usr/bin/perl -w #======================================================================== # # t/sys.t # # AppConfig::Sys test file. # # Written by Andy Wardley # # Copyright (C) 1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # #======================================================================== use strict; use vars qw($loaded); use AppConfig::Sys; use Test::More tests => 2; my $DEBUG = grep(/^--?d(ebug)?$/, @ARGV); # create two alternate AppConfig::Sys objects my $sys = AppConfig::Sys->new(); # auto-detect my $winsys = AppConfig::Sys->new('win32'); ok( defined $sys, 'created system object' ); ok( defined $winsys, 'created windows object' ); $sys->_dump if $DEBUG; $winsys->_dump if $DEBUG; if ($DEBUG) { foreach my $s ($sys, $winsys) { print "- " x 36, "\n"; print " os: ", $s->os, "\n"; print " pathsep: ", $s->pathsep, "\n"; print "can_getpwuid: ", $s->can_getpwuid(), "\n"; if($s->can_getpwuid()) { print " getpwuid: ", scalar $s->getpwuid($<), "\n"; print " getpwuid: ", scalar $s->getpwuid(), "\n"; } else { print " getpwuid not available on this platform.\n"; } print "can_getpwnam: ", $s->can_getpwnam(), "\n"; if($s->can_getpwnam()) { print " getpwnam: ", $s->getpwnam('abw'), "\n"; print " getpwnam: ", $s->getpwnam(), "\n"; } else { print " getpwnam not available on this platform.\n"; } } } appconfig-1.66.orig/TODO0000644000000000000000000000375710627254543011755 0ustar #============================================================================ # # TODO # # List of outstandings bugs, features and ideas for AppConfig::* modules. # Please note that the thoughts expressed here do not necessarily imply # any guaranteed future functionality of AppConfig. Please contact the # author if you wish to help implement anything here. All help is welcome, # but do check first to make sure someone isn't already tackling the item # in question. Any other suggestions, ideas, patches gratefully received. # # Written by Andy Wardley # # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. # All Rights Reserved. # #---------------------------------------------------------------------------- # # $Id: TODO,v 1.1.1.1 1999/09/14 16:39:44 abw Exp $ # #============================================================================ *** IMPORTANT *** * change varlist() to varhash() AppConfig::State * Perhaps allow a callback to be installed which is called *instead* of the get() and set() methods (or rather, is called by them). * CASE sensitivity may be required on a per-operation basis. E.g. CASE sensitive for AppConfig::Args but CASE insensitive for AppConfig::File. * AppConfig::State may need to have CMDARG re-introduced. When using blocks, it will be considerably more convenient to say '-v' rather than -block_verbose. The global CMDARG could be a template of the form '%c', to indicate the first character, for example. #------------------------------------------------------------------------ General * Change _pedantic() and _debug() calls in AppConfig::* constructors to direct $state->{ XXX } lookups. We are friends, after all and the current approach is likely to be rather inefficient. #------------------------------------------------------------------------ Test Suite * Modify file expansion tests to determine if getpwnam() etc are working or not. #------------------------------------------------------------------------