1431 lines
46 KiB
Perl
1431 lines
46 KiB
Perl
#============================================================================
|
|
#
|
|
# 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 <abw@wardley.org>
|
|
#
|
|
# 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 5.006;
|
|
use strict;
|
|
use warnings;
|
|
|
|
our $VERSION = '1.71';
|
|
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<var>" to "<var>"
|
|
$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 }
|
|
: "<undef>",
|
|
"\n"
|
|
if $DEBUG;
|
|
|
|
# return variable value, possibly negated if the name was "no<var>"
|
|
$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<var>" to "<var>"
|
|
$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
|
|
: "<undef>",
|
|
")\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 "<key>=<value>" 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<var>" 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<var>"
|
|
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 }
|
|
: "<undef>";
|
|
|
|
# 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 }
|
|
: "<undef>";
|
|
}
|
|
|
|
# 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->{ $_ } : "<undef>";
|
|
}
|
|
|
|
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-E<gt>variable($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<gt>_debug(1)>) or as a package function
|
|
(C<AppConfig::State::_debug(1)>), 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 => '<undef>', # 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<DEFINING VARIABLES> below which describes these options in detail.
|
|
|
|
=back
|
|
|
|
=head2 DEFINING VARIABLES
|
|
|
|
The C<define()> 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<EXPAND_UID | EXPAND_VAR>).
|
|
|
|
=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<HOME>
|
|
environment variable. In the second case, the C<getpwnam()> 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<EXPAND_VARS | EXPAND_UIDS | EXPAND_ENVS>).
|
|
|
|
=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<DESCRIPTION>
|
|
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-E<gt>set()> to update the same variable
|
|
from within the ACTION function will cause a recursive loop as the
|
|
ACTION function is repeatedly called.
|
|
|
|
=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<set()> takes an additional parameter which is the new value for the
|
|
variable. C<set()> 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<set()>. The C<get()> 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 VARLIST
|
|
|
|
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 = $state->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.
|
|
|
|
$state->file_name("/tmp/file");
|
|
$state->file_path("/foo:/bar:/baz");
|
|
|
|
my %vars = $state->varlist("^file_", 1);
|
|
|
|
# %vars:
|
|
# name => /tmp/file
|
|
# path => "/foo:/bar:/baz"
|
|
|
|
=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, E<lt>abw@wardley.orgE<gt>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
|
|
|
|
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
|
|
|
|
This module is free software; you can redistribute it and/or modify it
|
|
under the same terms as Perl itself.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
AppConfig, AppConfig::File, AppConfig::Args, AppConfig::Getopt
|
|
|
|
=cut
|