Advanced-Config
view release on metacpan or search on metacpan
if ( $file ) {
# Convert relative paths to absolute path names.
# Removes internal ".", but not ".." in the path info ...
# It also doesn't resolve symbolic links.
unless ( File::Spec->file_name_is_absolute ( $file ) ) {
if ( $dir ) {
$file = File::Spec->rel2abs ( File::Spec->catfile ( $dir, $file ) );
} else {
$file = File::Spec->rel2abs ( $file );
}
}
# Now let's remove any relative path info (..) from the new absolute path.
# Still not resolving any symbolic links on purpose!
# I don't agree with File::Spec->canonpath()'s reasoning for not doing it
# that way. So I need to resolve it myself.
my @parts = File::Spec->splitdir ( $file );
foreach ( 1..$#parts ) {
if ( $parts[$_] eq ".." ) {
$parts[$_] = $parts[$_ - 1] = "";
}
}
# It's smart enough to ignore "" in the array!
$file = File::Spec->catdir (@parts);
}
DBUG_RETURN ( $file );
}
# ----------------------------------------------------------------------------
# Start of the exposed methods in the module ...
# ----------------------------------------------------------------------------
=head1 CONSTRUCTORS
To use this module, you must call C<B<new>()> to create the I<Advanced::Config>
object you wish to work with. All it does is create an empty object for you to
reference and returns the C<Advanced::Config> object created. Once you
have this object reference you are good to go! You can either load an existing
config file into memory or dynamically build your own virtual config file or
even do a mixure of both!
=over
=item $cfg = Advanced::Config->new( [$filename[, \%read_opts[, \%get_opts[, \%date_var_opts]]]] );
It takes four arguments, any of which can be omitted or B<undef> during object
creation!
F<$filename> is the optional name of the config file to read in. It can be a
relative path. The absolute path to it will be calculated for you if a relative
path was given.
F<\%read_opts> is an optional hash reference that controls the default parsing
of the config file as it's being read into memory. Feel free to leave as
B<undef> if you're satisfied with this module's default behavior.
F<\%get_opts> is an optional hash reference that defines the default behavior
when this module looks something up in the config file. Feel free to leave as
B<undef> if you're satisfied with this module's default behavior.
F<\%date_var_opts> is an optional hash reference that defines the default
formatting of the special predefined date variables. Feel free to leave as
B<undef> if you're satisfied with the default formatting rules.
See the POD under L<Advanced::Config::Options> for more details on what options
these three hash references support! Look under the S<I<The Read Options>>,
S<I<The Get Options>>, and S<I<The Special Date Variable Formatting Options>>
sections of the POD.
It returns the I<Advanced::Config> object created.
Here's a few examples:
# Sets up an empty object.
$cfg = Advanced::Config->new();
# Just specifies the config file to use ...
$cfg = Advanced::Config->new("MyFile.cfg");
# Overrides some of the default featurs of the module ...
$cfg = Advanced::Config->new("MyFile.cfg",
{ "assign" => ":=", "comment" => ";" },
{ "required" => 1, "date_language" => "German" },
{ "month_type" => 2, "month_language" => "German" } );
=cut
sub new
{
DBUG_ENTER_FUNC ( @_ );
my $prototype = shift;;
my $filename = shift;
my $read_opts = shift; # A hash ref of "read" options ...
my $get_opts = shift; # Another hash ref of "get" options ...
my $date_opts = shift; # Another hash ref of "date" formatting options ...
my $class = ref ( $prototype ) || $prototype;
my $self = {};
# Create an empty object ...
bless ( $self, $class );
# Creating a new object ... (The main section)
my %control;
# Initialize what options were selected ...
$control{filename} = $self->_fix_path ($filename);
$control{read_opts} = get_read_opts ( $read_opts );
$control{get_opts} = get_get_opts ( $get_opts );
$control{date_opts} = get_date_opts ( $date_opts );
my ( %dates, %empty, %mods, %ropts, %rec, @lst );
# Special Date Variables ...
set_special_date_vars ($control{date_opts}, \%dates);
$control{DATES} = \%dates;
$control{DATE_USED} = 0;
local $opts->{required} = $req;
croak_helper ($opts, "No such tag ($tag), nor is it a date string.", undef);
return ( undef, 0, "", 0, 0, $req ); # No such tag/date ...
}
}
# The tag exists, then it must reference a date!
local $opts->{date_active} = 1;
($data, $req) = $self->_base_get ( $tag, $opts, 0 );
if ( defined $data ) {
return ( $data->{VALUE}, $data->{MASK_IN_FISH}, $data->{FILE}, $data->{ENCRYPTED}, $data->{VARIABLE}, $req );
} else {
return ( undef, 0, "", 0, 0, $req ); # Not a date ...
}
}
#######################################
=back
=head2 Accessing the contents of an Advanced::Config object.
These methods allow you to access the data loaded into this object.
They all look in the current section for the B<tag> and if the B<tag> couldn't
be found in this section and the I<inherit> option was also set, it will then
look in the parent/main section for the B<tag>. But if the I<inherit> option
wasn't set it wouldn't look there.
If the requested B<tag> couldn't be found, they return B<undef>. But if the
I<required> option was used, it may call B<die> instead!
But normally they just return the requested B<tag>'s value.
They all use F<%override_get_opts>, passed by value or by reference, as an
optional argument that overrides the default options provided in the call
to F<new()>. The I<inherit> and I<required> options discussed above are two
such options. In most cases this hash argument isn't needed. So leave it off
if you are happy with the current defaults!
See the POD under L<Advanced::Config::Options>, I<The Get Options> for more
details on what options you may override.
Only the B<L<get_value>> function was truly needed. But the other I<get>
methods were added for a couple of reasons. First to make it clear in your code
what type of value is being returned and provide the ability to do validation of
the B<tag>'s value without having to validate it yourself! Another benefit was
that it drastically reduced the number of exposed I<Get Options> needed for this
module. Making it easier to use.
Finally when these extra methods apply their validation, if the B<tag>'s value
fails the test, it treats it as a I<B<tag> not found> situation as described
above.
=over
=item $value = $cfg->get_value ( $tag[, %override_get_opts] );
This function looks up the requested B<tag>'s value and returns it.
See common details above.
=cut
sub get_value
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $opt_ref = $_[0]; # The override options ...
$opt_ref = $self->_get_opt_args ( @_ ) if ( defined $opt_ref );
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value );
}
#######################################
# A helper function to handle the various ways to find a hash as an argument!
# Handles all 3 cases.
# undef - No arguments
# hash ref - passed by reference
# something else - passed by value. (array)
sub _get_opt_args
{
my $self = shift; # Reference to the current section.
my $opt_ref = $_[0]; # May be undef, a hash ref, or start of a hash ...
# Convert the parameter array into a regular old hash reference ...
my %opts;
unless ( defined $opt_ref ) {
$opt_ref = \%opts;
} elsif ( ref ($opt_ref) ne "HASH" ) {
%opts = @_;
$opt_ref = \%opts;
}
return ( $opt_ref ); # The hash reference to use ...
}
#######################################
# Another helper function to help with evaluating which value to use ...
# Does a 4 step check.
# 1) Use the $value if provided.
# 2) If the key exists in the hash returned by _get_opt_args(), use it.
# 3) Look it up in the default "Get Options" set via call to new().
# 4) undef if all the above fail.
sub _evaluate_hash_values
{
my $self = shift; # References the current section.
my $key = shift; # The hash key to look up ...
my $ghash = shift; # A hash ref returned by _get_opt_args().
my $value = shift; # Use only if explicitly set ...
unless ( defined $value ) {
if ( defined $ghash && exists $ghash->{$key} ) {
$value = $ghash->{$key}; # Passed via the get options hash ...
} else {
# Use the default from the call to new() ...
my $pcfg = $self->{PARENT} || $self;
if ( exists $pcfg->{CONTROL}->{get_opts}->{$key} ) {
$value = $pcfg->{CONTROL}->{get_opts}->{$key};
}
}
}
return ( $value ); # The value to use ...
}
#######################################
=item $value = $cfg->get_integer ( $tag[, $rt_flag[, %override_get_opts]] );
This function looks up the requested B<tag>'s value and returns it if its an
integer. If the B<tag>'s value is a floating point number (ex 3.6), then the
value is either truncated or rounded up based on the setting of the I<rt_flag>.
If I<rt_flag> is set, it will perform truncation, so 3.6 becomes B<3>. If the
flag is B<undef> or zero, it does rounding, so 3.6 becomes B<4>. Meaning the
default is rounding.
Otherwise if the B<tag> doesn't exist or its value is not numeric it will
return B<undef> unless it's been marked as I<required>. In that case B<die>
may be called instead.
=cut
sub get_integer
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $rt_flag = shift; # 1 - truncate, 0 - rounding.
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Flag if we should use truncation (2) or rounding (1) if needed ...
local $opt_ref->{numeric} = $rt_flag ? 2 : 1;
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value );
}
#######################################
=item $value = $cfg->get_numeric ( $tag[, %override_get_opts] );
This function looks up the requested B<tag>'s value and returns it if its
value is numeric. Which means any valid integer or floating point number!
If the B<tag> doesn't exist or its value is not numeric it will return B<undef>
unless it's been marked as I<required>. In that case B<die> may be called
instead.
=cut
sub get_numeric
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Asking for a floating point number ...
local $opt_ref->{numeric} = 3;
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value );
}
#######################################
=item $value = $cfg->get_boolean ( $tag[, %override_get_opts] );
Treats the B<tag>'s value as a boolean value and returns I<undef>,
B<0> or B<1>.
Sometimes you just want to allow for basically a true/false answer
without having to force a particular usage in the config file.
This function converts the B<tag>'s value accordingly.
So it handles pairs like: Yes/No, True/False, Good/Bad, Y/N, T/F, G/B, 1/0,
On/Off, etc. and converts them into a boolean value. This test is case
insensitive. It never returns what's actually in the config file.
If it doesn't recognize something it always returns B<0>.
=cut
sub get_boolean
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Turns on the treat as a boolean option ...
local $opt_ref->{auto_true} = 1;
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value );
}
#######################################
=item $date = $cfg->get_date ( $tag[, $language[, %override_get_opts]] );
This function looks up the requested B<tag>'s value and returns it if its
value contains a valid date. The returned value will always be in I<YYYY-MM-DD>
format no matter what format or language was actually used in the config file
for the date.
If the B<tag> doesn't exist or its value is not a date it will return B<undef>
unless it's been marked as I<required>. In that case B<die> may be called
instead.
If I<$language> is undefined, it will use the default language defined in the
call to I<new> for parsing the date. (B<English> if not overridden.) Otherwise
it must be a valid language defined by B<Date::Language>. If it's a wrong or
bad language, your date might not be recognized as valid.
Unlike most other B<get> options, when parsing the B<tag>'s value, it's not
looking to match the entire string. It's looking for a date portion inside the
value and ignores any miscellaneous information. There was just too many
semi-valid potential surrounding data to worry about parsing that info as well.
So B<Tues "January 3rd, 2017" at 6:00 PM> returns "2017-01-03".
There are also a few date related options for I<%override_get_opts> to use that
you may find useful.
See L<Advanced::Config::Date> for more details.
=cut
sub get_date
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $language = shift; # The language the date appears in ...
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
local $opt_ref->{date_active} = 1;
local $opt_ref->{date_language} = $language if ( defined $language );
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value );
}
#######################################
=item $hyd = $cfg->get_hyd_date ( $tag[, $language[, %override_get_opts]] );
Behaves the same as B<get_date> except that it returns the date in the Hundred
Year Date (I<hyd>) format. Which is defined as the number of days since
B<Jan 1, 1900>. Which has the I<$hyd> of B<1>.
But if the tag B<$tag> doesn't exist in the config file, and it's name is in the
format of I<YYYY-MM-DD>, it will return the I<hyd> for that date instead.
This date format makes it very easy to do math against dates,
See L<Advanced::Config::Date> for more details.
them if you wish in any order. Ex: B<rw> or B<wr>.
=cut
sub get_directory
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $access = shift; # undef or contains "r" and/or "w" ...
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Verify that the tag's value points to an existing directory ...
# Execute permission is always required to reference a directory's contents.
local $opt_ref->{directory} = 1; # Existance ...
if ( defined $access ) {
$opt_ref->{directory} |= 2 | 8 if ( $access =~ m/[rR]/ ); # dr-x
$opt_ref->{directory} |= 4 | 8 if ( $access =~ m/[wW]/ ); # d-wx
}
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value );
}
#######################################
=back
=head2 Accessing the contents of an Advanced::Config object in LIST mode.
These methods allow you to access the data loaded into each B<tag> in list mode.
Splitting the B<tag>'s data up into arrays and hashes. Otherwise these
functions behave similarly to the one's above.
Each function asks for a I<pattern> used to split the B<tag>'s value into an
array of values. If the pattern is B<undef> it will use the default
I<split_pattern> specified during he call to F<new()>. Otherwise it can be
either a string or a RegEx. See Perl's I<split> function for more details.
After the value has been split, it will perform any requested validation and
most functions will return B<undef> if even one element in the list fails it's
edits. It was added as its own argument, instead of just relying on the
override option hash, since this option is probably the one that gets overridden
most often.
They also support the same I<inherit> and I<required> options described for the
scalar functions as well.
They also all allow F<%override_get_opts>, passed by value or by reference, as
an optional argument that overrides the default options provided in the call
to F<new()>. If you should use both option I<split_pattern> and the I<pattern>
argument, the I<pattern> argument takes precedence. So leave this optional
hash argument off if you are happy with the current defaults.
=over
=item $array_ref = $cfg->get_list_values ( $tag[, $pattern[, $sort[, %override_get_opts ]]] );
This function looks up the requested B<tag>'s value and then splits it up into
an array and returns a reference to it.
If I<sort> is 1 it does an ascending sort. If I<sort> is -1, it will do a
descending sort instead. By default it will do no sort.
See the common section above for more details.
=cut
sub get_list_values
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $split_ptrn = shift; # The split pattern to use to call to split().
my $sort = shift; # The sort order.
my $opt_ref = $self->_get_opt_args ( @_ ); # The override options ...
# Tells us to split the tag's value up into an array ...
local $opt_ref->{split} = 1;
# Tells how to spit up the tag's value ...
local $opt_ref->{split_pattern} =
$self->_evaluate_hash_values ("split_pattern", $opt_ref, $split_ptrn);
# Tells how to sort the resulting array ...
local $opt_ref->{sort} =
$self->_evaluate_hash_values ("sort", $opt_ref, $sort);
my ( $value, $sensitive ) = $self->_base_get2 ( $tag, $opt_ref );
DBUG_MASK (0) if ( $sensitive );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
=item $hash_ref = $cfg->get_hash_values ( $tag[, $pattern[, $value[, \%merge[, %override_get_opts]]]] );
This method is a bit more complex than L<get_list_values>. Like that method it
splits up the B<tag>'s value into an array. But it then converts that array
into the keys of a hash whose value for each entry is set to I<value>.
Then if the optional I<merge> hash reference was provided, and that key isn't
present in that hash, it adds the missing value to the I<merge> hash. It never
overrides any existing entries in the I<merge> hash!
It always returns the hash reference based on the B<tag>'s split value or an
empty hash if the B<tag> doesn't exist or has no value.
=cut
sub get_hash_values
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $split_ptrn = shift; # The split pattern to use to call to split().
my $hash_value = shift; # Value to assign to each hash member.
If no I<$section_name> was provided, it returns the default I<main> section.
=cut
sub get_section
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $section = shift;
my $required = shift || 0;
$self = $self->{PARENT} || $self; # Force to parent section ...
unless ( defined $section ) {
$section = DEFAULT_SECTION;
} elsif ( $section =~ m/^\s*$/ ) {
$section = DEFAULT_SECTION;
} else {
$section = lc ($section);
$section =~ s/^\s+//;
$section =~ s/\s+$//;
}
if ( exists $self->{SECTIONS}->{$section} ) {
return DBUG_RETURN ( $self->{SECTIONS}->{$section} );
}
if ( $required ) {
die ("Section \"$section\" doesn't exist in this ", __PACKAGE__,
" class!\n");
}
DBUG_RETURN (undef);
}
#######################################
=item $name = $cfg->section_name ( );
This function returns the name of the current section I<$cfg> points to.
=cut
sub section_name
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
DBUG_RETURN ( $self->{SECTION_NAME} );
}
#######################################
=item $scfg = $cfg->create_section ( $name );
Creates a new section called I<$name> within the current Advanced::Config object
I<$cfg>. It returns the I<Advanced::Config> object that it created. If a
section of that same name already exists it will return B<undef>.
There is no such thing as sub-sections, so if I<$cfg> is already points to a
section, then it looks up the parent object and associates the new section with
the parent object instead.
=cut
sub create_section
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $name = shift;
# This test bypasses all the die logic in the special case constructor!
# That constructor is no longer exposed in the POD.
if ( $self->get_section ( $name ) ) {
return DBUG_RETURN (undef); # Name is already in use ...
}
DBUG_RETURN ( $self->new_section ( $self, $name ) );
}
#######################################
=back
=head2 Searching the contents of an Advanced::Config object.
This section deals with the methods available for searching for content within
your B<Advanced::Config> object.
=over
=item @list = $cfg->find_tags ( $pattern[, $override_inherit] );
It returns a list of all tags whose name contains the passed pattern.
If the pattern is B<undef> or the empty string, it will return all tags in
the current section. Otherwise it does a case insensitive comparison of the
pattern against each tag to see if it should be returned or not.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section.
The returned list of tags will be sorted in alphabetical order.
=cut
sub find_tags
{
DBUG_ENTER_FUNC (@_);
my $self = shift;
my $pattern = shift;
my $inherit = shift; # undef, 0, or 1.
my @lst; # The list of tags found ...
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
foreach my $tag ( sort keys %{$self->{DATA}} ) {
unless ( $pattern ) {
push (@lst, $tag);
} elsif ( $tag =~ m/${pattern}/i ) {
push (@lst, $tag);
}
}
# Are we searching the parent/main section as well?
if ( $inherit && $pcfg != $self ) {
DBUG_PRINT ("INFO", "Also searching the 'main' section ...");
foreach my $tg ( sort keys %{$pcfg->{DATA}} ) {
# Ignore tags repeated from the current section
next if ( exists $self->{DATA}->{$tg} );
unless ( $pattern ) {
push (@lst, $tg);
} elsif ( $tg =~ m/$pattern/i ) {
push (@lst, $tg);
}
}
@lst = sort ( @lst ); # Sort the merged list.
}
DBUG_RETURN ( @lst );
}
#######################################
# No pod on purpose since exposing it would just cause confusion.
# It's a special case variant for find_tags().
# Just called from Advanced::Config::Reader::apply_modifier.
sub _find_variables
{
DBUG_ENTER_FUNC (@_);
my $self = shift;
my $pattern = shift;
my %res;
# Find all tags begining with the pattern ...
foreach ( $self->find_tags ("^${pattern}") ) {
$res{$_} = 1;
}
# Find all environment variables starting with the given pattern ...
foreach ( keys %ENV ) {
# Never include these 2 special tags in any list ...
next if ( defined $secret_tag && $secret_tag eq $_ );
next if ( defined $fish_tag && $fish_tag eq $_ );
$res{$_} = 4 if ( $_ =~ m/^${pattern}/ );
}
# Skip checking the Perl special variables we use (rule 5)
# Since it's now part of (rule 6)
# Check the pre-defined module variables ... (rule 6)
foreach ( keys %begin_special_vars ) {
$res{$_} = 6 if ( $_ =~ m/^${pattern}/ );
}
# The special date variables ... (rule 7)
my $pcfg = $self->{PARENT} || $self;
foreach ( keys %{$pcfg->{CONTROL}->{DATES}} ) {
$res{$_} = 7 if ( $_ =~ m/^${pattern}/ );
}
DBUG_RETURN ( sort keys %res );
}
#######################################
=item @list = $cfg->find_values ( $pattern[, $override_inherit] );
It returns a list of all tags whose values contains the passed pattern.
If the pattern is B<undef> or the empty string, it will return all tags in
the current section. Otherwise it does a case insensitive comparison of the
pattern against each tag's value to see if it should be returned or not.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section.
The returned list of tags will be sorted in alphabetical order.
=cut
sub find_values
{
DBUG_ENTER_FUNC (@_);
my $self = shift;
my $pattern = shift;
my $inherit = shift;
my @lst; # The list of tags found ...
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
foreach my $tag ( sort keys %{$self->{DATA}} ) {
unless ( $pattern ) {
push (@lst, $tag);
} else {
my $value = $self->{DATA}->{$tag}->{VALUE};
if ( $value =~ m/$pattern/i ) {
push (@lst, $tag);
}
}
}
# Are we searching the parent/main section as well?
if ( $inherit && $pcfg != $self ) {
DBUG_PRINT ("INFO", "Also searching the main section ...");
foreach my $tg ( sort keys %{$pcfg->{DATA}} ) {
# Ignore tags repeated from the current section
next if ( exists $self->{DATA}->{$tg} );
unless ( $pattern ) {
push (@lst, $tg);
} else {
my $value = $pcfg->{DATA}->{$tg}->{VALUE};
if ( $value =~ m/$pattern/i ) {
push (@lst, $tg);
}
}
}
@lst = sort (@lst); # Sort the merged list.
}
DBUG_RETURN (@lst);
}
#######################################
=item @list = $cfg->find_sections ( $pattern );
It returns a list of all section names which match this pattern.
If the pattern is B<undef> or the empty string, it will return all the section
names. Otherwise it does a case insensitive comparison of the pattern against
This method returns references to copies of the current options used to
manipulate the config file. It returns copies of these hashes so feel free to
modify them without fear of affecting the behavior of this module.
=cut
sub get_cfg_settings
{
DBUG_ENTER_FUNC (@_);
my $self = shift;
# Get the main/parent section to work against!
my $pcfg = $self->{PARENT} || $self;
my $ctrl = $pcfg->{CONTROL};
my (%r_opts, %g_opts, %d_opts);
%r_opts = %{$ctrl->{read_opts}} if ( $ctrl && $ctrl->{read_opts} );
%g_opts = %{$ctrl->{get_opts}} if ( $ctrl && $ctrl->{get_opts} );
%d_opts = %{$ctrl->{date_opts}} if ( $ctrl && $ctrl->{date_opts} );
DBUG_RETURN ( \%r_opts, \%g_opts, \%d_opts );
}
#######################################
=item $cfg->export_tag_value_to_ENV ( $tag, $value );
Used to export the requested tag/value pair to the %ENV hash. If it's also
marked as an %ENV tag the config file depends on, it updates internal
bookkeeping so that it won't trigger false refreshes.
Once it's been promoted to the %ENV hash the change can't be backed out again.
=cut
sub export_tag_value_to_ENV
{
my $self = shift;
my $tag = shift;
my $value = shift;
my $hide = $_[0] || 0; # Not taken from stack on purpose ...
DBUG_ENTER_FUNC ( $self, $tag, ($hide ? "*"x8 : $value), @_ );
$ENV{$tag} = $value;
# Check if the change afects the refresh logic ...
my $pcfg = $self->{PARENT} || $self;
if ( exists $pcfg->{CONTROL}->{ENV}->{$tag} ) {
$pcfg->{CONTROL}->{ENV}->{$tag} = $value; # It did ...
}
DBUG_VOID_RETURN ();
}
#######################################
=item $sensitive = $cfg->chk_if_sensitive ( $tag[, $override_inherit] );
This function looks up the requested tag in the current section of the config
file and returns if this module thinks the existing value is sensitive (B<1>)
or not (B<0>).
If the tag doesn't exist, it will always return that it isn't sensitive. (B<0>)
An existing tag references sensitive data if one of the following is true.
1) Advanced::Config::Options::should_we_hide_sensitive_data() says it is
or it says the section the tag was found in was sensitive.
2) The config file marked the tag in its comment to HIDE it.
3) The config file marked it as being encrypted.
4) It referenced a variable that was marked as sensitive.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section for the tag.
=cut
sub chk_if_sensitive
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $inherit = shift; # undef, 0, or 1.
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
local $pcfg->{CONTROL}->{get_opts}->{inherit} = $inherit;
my $sensitive = ($self->_base_get2 ( $tag ))[1];
DBUG_RETURN ( $sensitive );
}
#######################################
=item $encrypted = $cfg->chk_if_still_encrypted ( $tag[, $override_inherit] );
This function looks up the requested tag in the current section of the config
file and returns if this module thinks the existing value is still encrypted
(B<1>) or not (B<0>).
If the tag doesn't exist, it will always return B<0>!
This module always automatically decrypts everything unless the "Read" option
B<disable_decryption> was used. In that case this method was added to detect
which tags still needed their values decrypted before they were used.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section for the tag.
=cut
sub chk_if_still_encrypted
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $inherit = shift; # undef, 0, or 1.
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
local $pcfg->{CONTROL}->{get_opts}->{inherit} = $inherit;
my $encrypted = ($self->_base_get2 ( $tag ))[3];
DBUG_RETURN ( $encrypted );
}
#######################################
=item $bool = $cfg->chk_if_still_uses_variables ( $tag[, $override_inherit] );
This function looks up the requested tag in the current section of the config
file and returns if the tag's value contained variables that failed to expand
when the config file was parsed. (B<1> - has variable, B<0> - none.)
If the tag doesn't exist, or you called C<set_value> to create it, this function
will always return B<0> for that tag!
There are only two cases where it can ever return true (B<1>). The first case
is when you used the B<disable_variables> option. The second case is if you
used the B<disable_decryption> option and you had a variable that referenced
a tag that is still encrypted. But use of those two options should be rare.
If I<override_inherit> is provided it overrides the current I<inherit> option's
setting. If B<undef> it uses the current I<inherit> setting. If I<inherit>
evaluates to true, it looks in the current section I<and> the main section for
a match. Otherwise it just looks in the current section for the tag.
=cut
sub chk_if_still_uses_variables
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $tag = shift; # The tag to look up ...
my $inherit = shift; # undef, 0, or 1.
my $pcfg = $self->{PARENT} || $self;
$inherit = $pcfg->{CONTROL}->{get_opts}->{inherit} unless (defined $inherit);
local $pcfg->{CONTROL}->{get_opts}->{inherit} = $inherit;
my $bool = ($self->_base_get2 ( $tag ))[4];
DBUG_RETURN ( $bool );
}
#######################################
=item $string = $cfg->toString ( [$addEncryptFlags[, \%override_read_opts] );
This function converts the current object into a string that is the equivalent
of the config file loaded into memory without any comments.
If I<$addEncryptFlags> is set to a non-zero value, it will add the needed
comment to the end of each line saying it's waiting to be encrypted. So that
you may later call B<encrypt_string> to encrypt it.
If you provide I<%override_read_opts> it will use the information in that hash
to format the string. Otherwise it will use the defaults from B<new()>.
=cut
sub toString
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $encrypt_flag = shift;
my $read_opts = $self->_get_opt_args ( @_ ); # The override options ...
my $pcfg = $self->{PARENT} || $self;
my $rOpts = get_read_opts ($read_opts, $pcfg->{CONTROL}->{read_opts});
my $cmt = "";
if ( $encrypt_flag ) {
$cmt = " " . format_encrypt_cmt ( $rOpts );
}
my $line;
my $string = "";
my $cnt = 0;
foreach my $name ( $self->find_sections () ) {
my $cfg = $self->get_section ($name);
$line = format_section_line ($name, $rOpts);
$string .= "\n${line}\n";
( run in 1.002 second using v1.01-cache-2.11-cpan-39bf76dae61 )