AppConfig
view release on metacpan or search on metacpan
lib/AppConfig/State.pm view on Meta::CPAN
# 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) {
lib/AppConfig/State.pm view on Meta::CPAN
# 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) {
lib/AppConfig/State.pm view on Meta::CPAN
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',
});
lib/AppConfig/State.pm view on Meta::CPAN
# 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
( run in 0.576 second using v1.01-cache-2.11-cpan-39bf76dae61 )