Config-Hierarchical
view release on metacpan or search on metacpan
lib/Config/Hierarchical.pm view on Meta::CPAN
=item * GET_CATEGORIES
This option allows you to define functions that fetch variables in a specific category
list and in a specific order.
my $config = new Config::Hierarchical
(
CATEGORY_NAMES => ['CLI', '<PBS>', 'PARENT', 'CURRENT', 'LOCAL'],
GET_CATEGORIES =>
{
Inheritable => ['CLI', 'PBS', 'PARENT', 'CURRENT'],
}
...
) ;
my $value = $config->GetInheritable(NAME => 'CC') ;
my $hash_ref = $config->GetInheritableHashRef() ;
In the example above, the B<LOCAL> category will not be used by B<GetInheritable>.
=item * WARN_FOR_EXPLICIT_CATEGORY
if set, B<Config::Hierarchical> will display a warning if any category is specified in C<Get> or C<Set>.
=item * VERBOSE
This module will display information about its actions when this option is set.
See B<INTERACTION> and C<SetDisplayExplicitCategoryWarningOption>.
=item * INTERACTION
Lets you define subs used to interact with the user.
my $config = new Config::Hierarchical
(
INTERACTION =>
{
INFO => \&sub,
WARN => \&sub,
DIE => \&sub,
DEBUG => \&sub,
}
) ;
=over 4
=item INFO
This sub will be used when displaying B<verbose> information.
=item WARN
This sub will be used when a warning is displayed. e.g. a configuration that is refused or an override.
=item DIE
Used when an error occurs. E.g. a locked variable is set.
=item DEBUG
If this option is set, Config::Hierarchical will call the sub before and after acting on the configuration.
This can act as a breakpoint in a debugger or allows you to pinpoint a configuration problem.
=back
The functions default to:
=over 2
=item * INFO => CORE::print
=item * WARN => Carp::carp
=item * DIE => Carp::confess
=back
=item * FILE and LINE
These will be used in the information message and the history information if set. If not set, the values
returned by I<caller> will be used. These options allow you to write wrapper functions that report the
callers location properly.
=item * INITIAL_VALUES
Lets you initialize the Config::Hierarchical object. Each entry will be passed to C<Set>.
my $config = new Config::Hierarchical
(
...
EVALUATOR => \&sub,
INITIAL_VALUES =>
[
{ # aliased category
CATEGORY => 'PBS',
ALIAS_CATEGORY => $pbs_config,
HISTORY => ....,
COMMENT => ....,
},
{CATEGORY => 'CLI', NAME => 'CC', VALUE => 1},
{CATEGORY => 'CLI', NAME => 'LD', VALUE => 2, LOCK => 1},
{CATEGORY => 'CURRENT', NAME => 'CC', VALUE => 3, OVERRIDE => 1},
{CATEGORY => 'CURRENT', NAME => 'AS', VALUE => 4,},
} ,
) ;
See C<Set> for options to B<INITIAL_VALUES> and a details explanation about B<EVALUATOR>.
B<Aliased categories> allow you to use a category to refer to an existing Config::Hierarchical object.
The referenced object is read only. This is because multiple configurations might alias to the same
B<Config::Hierarchical> object.
Variables from aliased category can still be overridden.
lib/Config/Hierarchical.pm view on Meta::CPAN
=cut
my ($self, $package, $file_name, $line, @setup_data) = @_ ;
SetInteractionDefault($self) ;
$self->CheckOptionNames
(
{ %{$VALID_OPTIONS}, %{$CONSTRUCTOR_VALID_OPTIONS}},
@setup_data,
NAME => 'Anonymous eval context', FILE => $file_name, LINE => $line,
) ;
%{$self} =
(
NAME => 'Anonymous',
CATEGORY_NAMES => ['CURRENT'],
DISABLE_SILENT_OPTIONS => 0,
FILE => $file_name,
LINE => $line,
@setup_data,
CATEGORIES => {},
TIME_STAMP => 0,
) ;
SetInteractionDefault($self) ;
my $location = "$self->{FILE}:$self->{LINE}" ;
if($self->{VERBOSE})
{
$self->{INTERACTION}{INFO}('Creating ' . ref($self) . " '$self->{NAME}' at $location.\n") ;
}
$self->SetupCategories($location) ;
if(exists $self->{VALIDATORS})
{
$self->AddValidators($self->{VALIDATORS}, $location) ;
delete $self->{VALIDATORS} ;
}
if(exists $self->{SET_VALIDATOR})
{
if('CODE' ne ref $self->{SET_VALIDATOR})
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid 'SET_VALIDATOR' definition, expecting a sub reference at '$location'!") ;
}
}
if(exists $self->{EVALUATOR})
{
if('CODE' ne ref $self->{EVALUATOR})
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid 'EVALUATOR' definition, expecting a sub reference at '$location'!") ;
}
}
# temporarely remove the locked categories till we have handled INITIAL_VALUES
my $category_locks ;
if(exists $self->{LOCKED_CATEGORIES})
{
if('ARRAY' ne ref $self->{LOCKED_CATEGORIES})
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid 'LOCKED_CATEGORIES' at '$location'!") ;
}
$category_locks = $self->{LOCKED_CATEGORIES} ;
delete $self->{LOCKED_CATEGORIES} ;
}
if(exists $self->{INITIAL_VALUES})
{
for my $element_data (@{$self->{INITIAL_VALUES}})
{
if(exists $element_data->{ALIAS_CATEGORY})
{
$self->SetCategoryAlias(FILE => $self->{FILE}, LINE => $self->{LINE}, %{$element_data}) ;
}
else
{
$self->Set(FILE => $self->{FILE}, LINE => $self->{LINE}, %{$element_data}) ;
}
}
delete $self->{INITIAL_VALUES} ;
if(defined $category_locks)
{
#TODO: should be a category attribute not a config attribute
$self->{LOCKED_CATEGORIES} = { map {$_ => 1} @{$category_locks} } ;
}
}
CreateCustomGetFunctions(keys %{ $self->{GET_CATEGORIES} }) if exists $self->{GET_CATEGORIES} ;
return(1) ;
}
#-------------------------------------------------------------------------------
sub SetInteractionDefault
{
=head2 [p] SetInteractionDefault
Sets {INTERACTION} fields that are not set by the user.
=cut
my ($interaction_container) = @_ ;
$interaction_container->{INTERACTION}{INFO} ||= sub {print @_} ; ## no critic (InputOutput::RequireCheckedSyscalls)
$interaction_container->{INTERACTION}{WARN} ||= \&Carp::carp ;
$interaction_container->{INTERACTION}{DIE} ||= \&Carp::confess ;
return ;
}
lib/Config/Hierarchical.pm view on Meta::CPAN
(
NAME => 'CC', VALUE => 'gcc',
# options
HISTORY => $history,
COMMENT => 'we like gcc'
CATEGORY => 'CLI',
VALIDATORS => {positive_value => \&PositiveValueValidator,}
FORCE_LOCK => 1,
LOCK => 1,
OVERRIDE => 1,
SILENT_OVERRIDE => 1,
ATTRIBUTE => 'some attribute',
FILE => 'some_file',
LINE => 1,
CHECK_LOWER_LEVEL_CATEGORIES => 1,
) ;
I<ARGUMENTS>
=over 2
=item * NAME - The variable's name. MANDATORY
=item * EVAL - Can be used instead for B<NAME>. See I<'Using EVAL instead for VALUE'>
=item * VALUE - A scalar value associated with the 'B<NAME>' variable. MANDATORY
=item * HISTORY
The argument passed is kept in the configuration variable. You can pass any scalar variable; B<Config::Hierarchical> will
not manipulate this information.
See C<GetHistory>.
=item * COMMENT
A comment that will be added to the variable history.
=item * CATEGORY
The name of the category where the variable resides. If no B<CATEGORY> is given, the default category is used.
=item * ATTRIBUTE
Set the configuration variable's attribute to the passed argument. See <SetAttribute>.
=item * SET_VALIDATOR
Configuration validators that will only be used during this call to B<Set>. The I<SET_VALIDATOR> set in the constructor
will not be called if this option is set. This lets you add configuration variable from different source and check them
with specialized validators.
=item * VALIDATORS
Extra validators that will only be used during this call to B<Set>.
=item * FORCE_LOCK
If a variable is locked, trying to set it will generate an error. It is possible to temporarily force
the lock with this option. A warning is displayed when a lock is forced.
=item * LOCK
Will lock the variable if set to 1, unlock if set to 0.
=item * OVERRIDE
This allows the variable in a category to override the variable in a category with higher priority. Once a variable
is overridden, it's value will always be the override value even if it is set again.
my $config = new Config::Hierarchical
(
NAME => 'Test config',
CATEGORY_NAMES => ['PARENT', 'CURRENT'],
DEFAULT_CATEGORY => 'CURRENT',
INITIAL_VALUES =>
[
{NAME => 'CC', CATEGORY => 'PARENT', VALUE => 'parent'},
] ,
) ;
$config->Set(NAME => 'CC', CATEGORY => 'CURRENT', OVERRIDE => 1, VALUE => 'current') ;
$config->Set(NAME => 'CC', CATEGORY => 'PARENT', VALUE => 'parent') ;
$config->Get(NAME => 'CC') ; # will return 'current'
=item * SILENT_OVERRIDE
Disables the warning displayed when overriding a variable.
=item * FILE and LINE
See B<FILE and LINE> in C<new>.
=item * CHECK_LOWER_LEVEL_CATEGORIES
B<Config::Hierarchical> display warnings about all the collisions with higher priority
categories. If this option is set, warnings will also be displayed for lower priority categories.
=back
=head3 History
B<Config::Hierarchical> will keep a history of all the setting you make. The history can be retrieved with C<GetHistory>.
The history is also part of the dump generated by C<GetDump>.
=head3 Using B<EVAL> instead for B<VALUE>
Quite often configuration variables values are base on other configuration variable values. A typical example
would be a set of paths.
my $config = new Config::Hierarchical() ;
$config->Set(NAME => 'BASE', VALUE => '/somewhere') ;
$config->Set(NAME => 'MODULE', VALUE => 'module') ;
$config->Set(NAME => 'CONFIG_FILE', VALUE => 'my_config') ;
lib/Config/Hierarchical.pm view on Meta::CPAN
B<EVAL> can be used in C<Set> and in B<INITIAL_VALUES>.
=cut
my ($self, @options) = @_ ;
$self->CheckOptionNames($VALID_OPTIONS, @options) ;
my %options = @options ;
unless(defined $options{FILE})
{
my ($package, $file_name, $line) = caller() ;
$options{FILE} = $file_name ;
$options{LINE} = $line ;
}
my $location = "$options{FILE}:$options{LINE}" ;
if(exists $options{CATEGORY})
{
if($self->{WARN_FOR_EXPLICIT_CATEGORY})
{
$self->{INTERACTION}{WARN}->("$self->{NAME}: Setting '$options{NAME}' using explicit category at '$location'!\n") ;
}
}
else
{
$options{CATEGORY} = $self->{DEFAULT_CATEGORY} ;
}
#~ use Data::TreeDumper ;
#~ print DumpTree {Options => \%options, Self => $self} ;
$self->CheckSetArguments(\%options, $location) ;
my $value_to_display = defined $options{VALUE} ? "'$options{VALUE}'" : 'undef' ;
# inform of action if option set
if($self->{VERBOSE})
{
$self->{INTERACTION}{INFO}->("$self->{NAME}: Setting '$options{CATEGORY}::$options{NAME}' to $value_to_display at '$location'.\n") ;
}
# run debug hook if any
if(defined $self->{INTERACTION}{DEBUG})
{
$self->{INTERACTION}{DEBUG}->
(
"Setting '$options{CATEGORY}::$options{NAME}' to $value_to_display at '$location'.",
$self,
\%options,
) ;
}
if(exists $self->{LOCKED_CATEGORIES}{$options{CATEGORY}})
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Variable '$options{CATEGORY}::$options{NAME}', category '$options{CATEGORY}' was locked at '$location'.\n") ;
}
if
(
exists $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}}
&& defined $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}}{OVERRIDE}
&& ! exists $options{OVERRIDE}
)
{
my $override_location = $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}}{OVERRIDE} ;
$self->{INTERACTION}{WARN}->("$self->{NAME}: '$options{NAME}' is of OVERRIDE type set at '$override_location' at '$location'!\n") ;
$options{OVERRIDE} = '1 (due to previous override)' ;
}
my ($high_priority_check_set_status, $high_priority_check_warnings) = $self->CheckHigherPriorityCategories(\%options, $location) ;
my ($low_priority_check_set_status, $low_priority_check_warnings) = ($EMPTY_STRING, $EMPTY_STRING) ;
if($self->{CHECK_LOWER_LEVEL_CATEGORIES} || $options{CHECK_LOWER_LEVEL_CATEGORIES})
{
($low_priority_check_set_status, $low_priority_check_warnings) = $self->CheckLowerPriorityCategories(\%options, $location) ;
}
my $warnings = $high_priority_check_warnings . $low_priority_check_warnings ;
my $set_status = $high_priority_check_set_status . $low_priority_check_set_status ;
if($warnings ne $EMPTY_STRING)
{
$self->{INTERACTION}{WARN}->
(
"$self->{NAME}: Setting '$options{CATEGORY}::$options{NAME}' at '$location':\n$warnings"
) ;
}
$self->CheckAndSetVariable(\%options, $set_status, $location) ;
return(1) ;
}
#-------------------------------------------------------------------------------
sub CheckSetArguments
{
=head2 [p] CheckSetArguments
Checks input to B<Set>.
=cut
my ($self, $options, $location) = @_ ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid category '$options->{CATEGORY}' at at '$location'!") unless exists $self->{VALID_CATEGORIES}{$options->{CATEGORY}} ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Missing name at '$location'!") unless defined $options->{NAME} ;
if(exists $options->{VALUE} && exists $options->{EVAL})
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Can't have 'VALUE' and 'EVAL' at '$location'!") ;
}
lib/Config/Hierarchical.pm view on Meta::CPAN
return($set_status, $warnings) ;
}
#-------------------------------------------------------------------------------
sub CheckAndSetVariable
{ ## no critic (ProhibitExcessComplexity)
=head2 [p] CheckAndSetVariable
Set the variable in its category, verify lock, etc..
=cut
my($self, $options, $set_status, $location) = @_ ;
my $config_variable_exists = exists $self->{CATEGORIES}{$options->{CATEGORY}}{$options->{NAME}} ;
my $action = $EMPTY_STRING ;
my $config_variable ;
$self->Validate($options, $set_status, $location, $config_variable_exists) ;
unless($config_variable_exists)
{
# didn't exist before this call
$config_variable = $self->{CATEGORIES}{$options->{CATEGORY}}{$options->{NAME}} = {} ;
$action .= 'CREATE' ;
$action .= exists $options->{HISTORY} ? ', SET HISTORY' : $EMPTY_STRING ;
$action .= exists $options->{ATTRIBUTE} ? ', SET ATTRIBUTE' : $EMPTY_STRING ;
$action .= ' AND SET' ;
$set_status .= 'OK.' ;
}
else
{
$action = 'SET' ;
$action .= exists $options->{ATTRIBUTE} ? ', SET ATTRIBUTE' : $EMPTY_STRING ;
if(exists $options->{HISTORY})
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Can't add history for already existing variable '$options->{CATEGORY}::$options->{NAME}' at '$location'.\n") ;
}
$config_variable = $self->{CATEGORIES}{$options->{CATEGORY}}{$options->{NAME}} ;
if(exists $config_variable->{OVERRIDDEN})
{
$self->{INTERACTION}{WARN}->("$self->{NAME}: Variable '$options->{CATEGORY}::$options->{NAME}' was overridden at '$config_variable->{OVERRIDDEN}'. The new value defined at '$location' might not be used.\n") ;
}
if(! Compare($config_variable->{VALUE}, $options->{VALUE}))
{
# not the same value
unless(exists $config_variable->{LOCKED})
{
#~ Not locked, set
$set_status .= 'OK.' ;
}
else
{
if($options->{FORCE_LOCK})
{
$set_status .= 'OK, forced lock.' ;
$self->{INTERACTION}{WARN}->("$self->{NAME}: Forcing locked variable '$options->{CATEGORY}::$options->{NAME}' at '$location'.\n") ;
}
else
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Variable '$options->{CATEGORY}::$options->{NAME}' was locked and couldn't be set at '$location'.\n") ;
}
}
}
else
{
$set_status .= 'OK, same value.' ;
}
}
$config_variable->{VALUE} = $options->{VALUE} ;
$config_variable->{OVERRIDE} = $location if $options->{OVERRIDE} ;
$config_variable->{ATTRIBUTE} = $options->{ATTRIBUTE} if $options->{ATTRIBUTE} ;
#~ set lock state
my $lock = $EMPTY_STRING ;
my $force_lock = $options->{FORCE_LOCK} ? 'FORCE_LOCK, ' : $EMPTY_STRING ;
if(exists $options->{LOCK})
{
if($options->{LOCK})
{
$lock = 'LOCK(1), ' ;
$config_variable->{LOCKED} = $location ;
}
else
{
$lock = 'LOCK(0), ' ;
delete $config_variable->{LOCKED} ;
}
}
# update history
my $override = exists $options->{OVERRIDE} ? 'OVERRIDE, ' : $EMPTY_STRING ;
my $value_to_display = defined $options->{VALUE} ? "'$options->{VALUE}'" : 'undef' ;
my $history = "$action. value = $value_to_display, ${override}${force_lock}${lock}category = '$options->{CATEGORY}' at '$options->{FILE}:$options->{LINE}', status = $set_status" ;
my $history_data = {TIME => $self->{TIME_STAMP}, EVENT => $history} ;
$history_data->{HISTORY} = $options->{HISTORY} if exists $options->{HISTORY} ;
$history_data->{COMMENT} = $options->{COMMENT} if exists $options->{COMMENT} ;
push @{$config_variable->{HISTORY}}, $history_data ;
$self->{TIME_STAMP}++ ;
return(1) ;
}
#-------------------------------------------------------------------------------
sub SetAttribute
{
=head2 SetAttribute(NAME => $variable_name, ATTRIBUTE => $attribute, CATEGORY => $category)
This sub allows you to attach an attribute per variable (the attribute you set is per category) other than a value.
It will raise an exception if you try to set a variable that does not exists or if you try to set an attribute to a variable
in an aliased category.
lib/Config/Hierarchical.pm view on Meta::CPAN
=cut
my ($self, $value) = @_ ;
$self->{WARN_FOR_EXPLICIT_CATEGORY} = $value ;
if($self->{VERBOSE})
{
my ($package, $file_name, $line) = caller() ;
$self->{INTERACTION}{INFO}->("$self->{NAME}: Setting 'WARN_FOR_EXPLICIT_CATEGORY' to '$value' at '$file_name:$line'.\n") ;
}
return(1) ;
}
#-------------------------------------------------------------------------------
sub SetDisableSilentOptions
{
=head2 SetDisableSilentOptions($boolean)
$config->SetDisableSilentOptions(1) ;
$config->SetDisableSilentOptions(0) ;
I<Arguments>
=over 2
=item * $boolean - controls if messages are displayed regardless of local warning disabling options
This is useful when debugging your configuration as it forces all the warning to be displayed.
=back
I<Return> - Nothing
=cut
my ($self, $silent) = @_ ;
$self->{DISABLE_SILENT_OPTIONS} = $silent ;
if($self->{VERBOSE})
{
my ($package, $file_name, $line) = caller() ;
$self->{INTERACTION}{INFO}->("$self->{NAME}: Setting 'DISABLE_SILENT_OPTIONS' to '$silent' at '$file_name:$line'.\n") ;
}
return(1) ;
}
#-------------------------------------------------------------------------------
sub LockCategories
{
=head2 LockCategories(@categories)
Locks the categories passed as argument. A variable in a locked category can not be set.
An attempt to set a locked variable will generate an error. B<FORCE_LOCK> has no effect on locked categories.
$config->LockCategories('PARENT', 'OTHER') ;
I<Arguments>
=over 2
=item * @categories - a list of categories to lock
=back
I<Returns> - Nothing
I<Exceptions> - An exception is generated if you try to lock a category that doesn't exist.
See C<UnlockCategories>.
=cut
my ($self, @categories) = @_ ;
my ($package, $file_name, $line) = caller() ;
my $location = "$file_name:$line" ;
for my $category (@categories)
{
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid category '$category' at '$location'!") unless exists $self->{VALID_CATEGORIES}{$category} ;
$self->{LOCKED_CATEGORIES}{$category} = 1 ;
}
return(1) ;
}
#-------------------------------------------------------------------------------
sub Lock
{
=head2 Lock(NAME => $variable_name, CATEGORY => $category)
Locks a variable in the default category or an explicit category. A locked variable can not be set.
To set a locked variable, B<FORCE_LOCK> can be used. B<FORCE_LOCK> usually pinpoints a problem
in your configuration.
$config->Lock(NAME => 'CC') ;
$config->Lock(NAME => 'CC', CATEGORY => 'PARENT') ;
I<Arguments>
=over 2
=item * NAME => $variable_name - Name of the variable to lock
=item * CATEGORY => $category - Name of the category containing the variable
=back
I<Returns> - Nothing
I<Exceptions> - An exception is generated if you try to lock a variable that doesn't exist.
See C<Set>.
=cut
my ($self, @options) = @_ ;
if (@options % 2)
{
$self->{INTERACTION}{DIE}->('Invalid number of argument!') ;
}
my %options = @options ;
unless(defined $options{FILE})
{
my ($package, $file_name, $line) = caller() ;
$options{FILE} = $file_name ;
$options{LINE} = $line ;
}
my $location = "$options{FILE}:$options{LINE}" ;
$options{CATEGORY} = $self->{DEFAULT_CATEGORY} unless exists $options{CATEGORY} ;
$self->CheckOptionNames($VALID_OPTIONS, %options) ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid category at '$location'!") unless exists $self->{VALID_CATEGORIES}{$options{CATEGORY}} ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Missing name at '$location'!") unless defined $options{NAME} ;
if($self->{VERBOSE})
{
$self->{INTERACTION}{INFO}->("$self->{NAME}: Locking '$options{CATEGORY}::$options{NAME}' at '$location'.\n") ;
}
if(exists $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}})
{
my $config_variable = $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}} ;
$config_variable->{LOCKED} = $location ;
lib/Config/Hierarchical.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
sub IsLocked
{
=head2 IsLocked(NAME => $variable_name, CATEGORY => $category)
Query the lock state of a variable.
$config->IsLocked(NAME => 'CC') ;
$config->IsLocked(NAME => 'CC', CATEGORY => 'PARENT') ;
I<Arguments>
=over 2
=item * NAME => $variable_name - Name of the variable to query
=item * Optional, CATEGORY => $category - Name of the category containing the variable
=back
I<Returns> - A boolean
I<Exceptions> - Querying the lock state of a variable that doesn't exist does not generate an exception.
=cut
my ($self, @options) = @_ ;
if (@options % 2)
{
$self->{INTERACTION}{DIE}->('Invalid number of argument!') ;
}
my %options = @options ;
unless(defined $options{FILE})
{
my ($package, $file_name, $line) = caller() ;
$options{FILE} = $file_name ;
$options{LINE} = $line ;
}
my $location = "$options{FILE}:$options{LINE}" ;
$options{CATEGORY} = $self->{DEFAULT_CATEGORY} unless exists $options{CATEGORY} ;
$self->CheckOptionNames($VALID_OPTIONS, %options) ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid category '$options{CATEGORY}' at '$location'!") unless exists $self->{VALID_CATEGORIES}{$options{CATEGORY}} ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Missing name at '$location'!") unless defined $options{NAME} ;
if($self->{VERBOSE})
{
$self->{INTERACTION}{INFO}->("$self->{NAME}: Checking Lock of '$options{CATEGORY}::$options{NAME}' at '$location'.\n") ;
}
my $locked = undef ;
if(exists $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}})
{
if(exists $self->{CATEGORIES}{$options{CATEGORY}}{$options{NAME}}{LOCKED})
{
$locked = 1 ;
}
else
{
$locked = 0 ;
}
}
return($locked) ;
}
#-------------------------------------------------------------------------------
sub Exists
{
=head2 Exists(NAME => $variable_name, CATEGORIES_TO_EXTRACT_FROM => \@categories)
$config->Exists(NAME => 'CC') ;
Returns B<true> if the variable exist, B<false> otherwise. All the categories are checked.
I<Arguments>
=over 2
=item * NAME => $variable_name - Name of the variable to check
=item * CATEGORIES_TO_EXTRACT_FROM => \@categories - list of category names
=back
I<Returns> - A boolean
I<Exceptions> - An exception is generated if you pass a category that doesn't exist.
=cut
my ($self, @options) = @_ ;
if (@options % 2)
{
$self->{INTERACTION}{DIE}->('Invalid number of argument!') ;
}
my %options = @options ;
unless(defined $options{FILE})
{
my ($package, $file_name, $line) = caller() ;
$options{FILE} = $file_name ;
$options{LINE} = $line ;
}
my $location = "$options{FILE}:$options{LINE}" ;
$self->CheckOptionNames($VALID_OPTIONS, %options) ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: Missing name at '$location'!") unless defined $options{NAME} ;
$self->{INTERACTION}{DIE}->("$self->{NAME}: 'CATEGORY' not used at '$location'!") if exists $options{CATEGORY} ;
if($self->{VERBOSE})
{
$self->{INTERACTION}{INFO}->("$self->{NAME}: Checking Existance of '$options{NAME}' at '$location'.\n") ;
}
my @categories_to_extract_from ;
( run in 1.902 second using v1.01-cache-2.11-cpan-39bf76dae61 )