Advanced-Config
view release on metacpan or search on metacpan
versions of your config files again for Production vs Development vs QA vs
different OS, etc.
=head1 NOTES ON FUNCTIONS WITH MULTIPLE RETURN VALUES
Whenever a function in this module or one if it's helper modules says it can
have multiple return values and you ask for them in scalar mode, it only returns
the first return value. The other return values are tossed. Not the count of
return values as some might expect.
This is because in most cases these secondary return values only have meaning
in special cases. So usually there's no need to grab them unless you plan on
using them.
For a list of the related helper modules see the B<SEE ALSO> section at the
end of this POD. These helper modules are not intended for general use.
=cut
# ---------------------------------------------------------------
package Advanced::Config;
use strict;
use warnings;
# The version of this module!
our $VERSION = "1.14";
use File::Basename;
use File::Copy;
use Sys::Hostname;
use File::Spec;
use Perl::OSType ':all';
use Cwd 'abs_path';
use Advanced::Config::Date;
use Advanced::Config::Options;
use Advanced::Config::Reader;
use Fred::Fish::DBUG 2.09 qw / on_if_set ADVANCED_CONFIG_FISH /;
# The name of the default section ... (even if no sections are defined!)
use constant DEFAULT_SECTION => Advanced::Config::Options::DEFAULT_SECTION_NAME;
# Should only be modifiable via BEGIN ...
my %begin_special_vars;
my $secret_tag;
my $fish_tag;
# This begin block initializes the special variables used
# for "rule 5" & "rule 6" in lookup_one_variable()
# and _find_variables()!
BEGIN
{
DBUG_ENTER_FUNC ();
# -----------------------------------------------
# These are the "Rule 5" special perl varibles.
# Done this way to avoid having to support
# indirect "eval" logic.
# -----------------------------------------------
$begin_special_vars{'0'} = ($0 eq "-e") ? "perl" : $0;
$begin_special_vars{'$'} = $$;
$begin_special_vars{'^O'} = $^O; # MSWin32, aix, etc ...
# ---------------------------------------------
# Start of the "rule 6" initialization ...
# ---------------------------------------------
$begin_special_vars{PID} = $$;
$begin_special_vars{user} = Advanced::Config::Options::_get_user_id ();
$begin_special_vars{hostname} = hostname ();
$begin_special_vars{flavor} = os_type (); # Windows, Unix, etc...
# ---------------------------------------------
# Get the Parent PID if available ... (PPID)
# ---------------------------------------------
eval {
$begin_special_vars{PPID} = getppid ();
};
if ( $@ ) {
DBUG_PRINT ("INFO", "Cheating to get the PPID. It may be wrong!");
# We can't easily get the parent process id for Windows.
# So we're going to cheat a bit. We'll ask if any parent
# or grandparent process used this module before and call it
# the parent process!
$secret_tag = "_ADVANCED_CONFIG_PPID_";
if ( $ENV{$secret_tag} ) {
$begin_special_vars{PPID} = $ENV{$secret_tag};
} else {
$begin_special_vars{PPID} = -1; # Can't figure out the PPID.
}
$ENV{$secret_tag} = $$;
}
# -----------------------------------------------------
# Calculate the separator used by the current OS
# when constructing a directory tree. (sep)
# -----------------------------------------------------
my ($a, $b) = ("one", "two");
my $p = File::Spec->catfile ($a, $b);
if ( $p =~ m/^${a}(.+)${b}$/ ) {
$begin_special_vars{sep} = $1; # We have it!
} else {
warn "Unknown separator for current OS!\n";
$begin_special_vars{sep} = ""; # Unknown value!
}
# -----------------------------------------------------
# Calculate the program name minus any path info or
# certain file extensions.
# -----------------------------------------------------
if ( $0 eq "-e" ) {
$begin_special_vars{program} = "perl"; # Perl add hock script!
} else {
$begin_special_vars{program} = basename ($0);
# Remove only certain file extensions from the program's name!
if ( $begin_special_vars{program} =~ m/^(.+)[.]([^.]*)$/ ) {
my ($f, $ext) = ($1, lc ($2));
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;
# Environment variables referenced ...
$control{ENV} = \%empty;
# Timestamps & options used for each config file loaded into memory ...
# Controls the refesh logic.
$control{REFRESH_MODIFY_TIME} = \%mods;
$control{REFRESH_READ_OPTIONS} = \%ropts;
# Used to detect recursion ...
$control{RECURSION} = \%rec;
# Used to detect recursion ...
$control{MERGE} = \@lst;
# The count for sensitive entries ...
$control{SENSITIVE_CNT} = sensitive_cnt ();
# Assume not allowing utf8/Unicode/Wide Char dates ...
# Or inside the config file itself.
$control{ALLOW_UTF8} = 0;
# Controls the behavior of this module.
# Only exists in the parent object.
$self->{CONTROL} = \%control;
my $key = $self->{SECTION_NAME} = DEFAULT_SECTION;
my %sections;
$sections{$key} = $self;
$self->{SECTIONS} = \%sections;
# Holds all the tag data for the main section in the config file.
my %data;
$self->{DATA} = \%data;
# Is the data all sensitive?
$self->{SENSITIVE_SECTION} = 0; # No for the default section ...
DBUG_RETURN ( $self );
}
# Only called by Advanced::Config::Reader::read_config() ...
# So not exposed in the POD!
# Didn't rely on read option 'use_utf8' since in many cases
# the option is misleading or just plain wrong!
sub _allow_utf8
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
# Tells calls to Advanced::Config::Options::apply_get_rules() that
# it's ok to use Wide Char Languages like Greek.
my $pcfg = $self->{PARENT} || $self;
$pcfg->{CONTROL}->{ALLOW_UTF8} = 1;
DBUG_VOID_RETURN ();
}
# This private method preps for a clean refresh of the objects contents.
# Kept after the consructor so I can remember to add any new hashes to
# the list below.
sub _wipe_internal_data
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
$self = $self->{PARENT} || $self;
# Get the filename to read ...
if ( $filename ) {
$filename = $self->_fix_path ($filename);
} else {
$filename = $self->{CONTROL}->{filename};
}
# Get the read options ...
my $new_opts;
if ( ! defined $read_opts ) {
my %none;
$new_opts = \%none;
} else {
$read_opts = {@_} if ( ref ($read_opts) ne "HASH" );
$new_opts = $read_opts;
}
$read_opts = get_read_opts ( $read_opts, $self->{CONTROL}->{read_opts} );
unless ( $filename ) {
my $msg = "You must provide a file name to load!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
unless ( -f $filename ) {
my $msg = "No such file or it's unreadable! -- $filename";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_PRINT ("READ", "Reading a config file into memory ... %s", $filename);
unless ( -f $filename && -r _ ) {
my $msg = "Your config file name doesn't exist or isn't readable.";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# Behaves diferently based on who calls us ...
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_config";
my $by2 = __PACKAGE__ . "::_load_config_with_new_date_opts";
if ( $c eq $by ) {
# Manually merging in another config file.
push (@{$self->{CONTROL}->{MERGE}}, $filename);
} elsif ( $c eq $by2 ) {
# Sourcing in a file says to remove these old decryption opts.
delete $read_opts->{alias} unless ( $new_opts->{alias} );
delete $read_opts->{pass_phrase} unless ( $new_opts->{pass_phrase} );
delete $read_opts->{encrypt_by_user} unless ( $new_opts->{encrypt_by_user} );
} else {
# Loading the original file ...
$self->_wipe_internal_data ( $filename );
}
# Auto add the alias if it's a symbolic link & there isn't an alias.
# Otherwise decryption won't work!
if ( -l $filename && ! $read_opts->{alias} ) {
$read_opts->{alias} = abs_path( $filename );
}
# So refresh logic will work ...
$self->{CONTROL}->{REFRESH_MODIFY_TIME}->{$filename} = (stat( $filename ))[9];
$self->{CONTROL}->{REFRESH_READ_OPTIONS}->{$filename} = get_read_opts ($read_opts);
# So will auto-clear if die is called!
local $self->{CONTROL}->{RECURSION}->{$filename} = 1;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $msg = "Reading the config file had serious issues!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_RETURN ( $self );
}
#######################################
=item $cfg = $cfg->load_string ( $string[, %override_read_opts] );
This method takes the passed I<$string> and treats it's value as the contents of
a config file. Modifying the I<$string> afterwards will not affect things. You
can use this as an alternative to F<load_config>.
Each time you call this method, it wipes the contents of the object and starts
you from a clean slate again. Making it safe to call multiple times if needed.
The I<%override_read_opts> options apply just to the current call to
I<load_string> and will be forgotten afterwards. If you want these options
to persist between calls, set the option via the call to B<new()>. This
argument can be passed either by value or by reference. Either way will work.
See L<Advanced::Config::Options> for more details.
If you plan on decrypting any values in the string, you must use the B<alias>
option in order for them to be successfully decrypted.
On success, it returns a reference to itself so that it can be initialized
separately or as a single unit.
=cut
sub load_string
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $string = shift; # The string to treat as a config file's contents.
my $read_opts = $_[0]; # Don't pop from the stack yet ...
$self = $self->{PARENT} || $self;
# Get the read options ...
$read_opts = {@_} if ( ref ($read_opts) ne "HASH" );
$read_opts = get_read_opts ( $read_opts, $self->{CONTROL}->{read_opts} );
unless ( $string ) {
my $msg = "You must provide a string to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# The filename is a reference to the string passed to this method!
my $filename = \$string;
# If there's no alias provided, use a default value for it ...
# There is no filename to use for decryption purposes without it.
$read_opts->{alias} = "STRING" unless ( $read_opts->{alias} );
# Dynamically correct based on type of string ...
$read_opts->{use_utf8} = ( $string =~ m/[^\x00-\xff]/ ) ? 1 : 0;
# Behaves diferently based on who calls us ...
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_string";
if ( $c eq $by ) {
# Manually merging in another string as a config file.
push (@{$self->{CONTROL}->{MERGE}}, $filename);
} else {
# Loading the original string ...
$self->_wipe_internal_data ( $filename );
}
# So refresh logic will work ...
$self->{CONTROL}->{REFRESH_MODIFY_TIME}->{$filename} = 0; # No timestamp!
$self->{CONTROL}->{REFRESH_READ_OPTIONS}->{$filename} = get_read_opts ($read_opts);
# So will auto-clear if die is called!
local $self->{CONTROL}->{RECURSION}->{$filename} = 1;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $msg = "Reading the config file had serious issues!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_RETURN ( $self );
}
#######################################
# No POD on purpose ...
# For use by Advanced::Config::Reader only.
# Purpose is to allow source_file() a way to modify the date options.
sub _load_config_with_new_date_opts
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $filename = shift;
my $read_opts = shift;
my $date_opts = shift;
$self = $self->{PARENT} || $self;
my $res;
if ( $date_opts ) {
my %dates;
$date_opts = get_date_opts ( $date_opts, $self->{CONTROL}->{date_opts} );
change_special_date_vars ( $self->{CONTROL}->{DATES}->{timestamp},
$date_opts, \%dates );
# Temp override of the default date info ...
local $self->{CONTROL}->{date_opts} = $date_opts;
local $self->{CONTROL}->{DATES} = \%dates;
$res = $self->load_config ( $filename, $read_opts );
} else {
$res = $self->load_config ( $filename, $read_opts );
}
DBUG_RETURN ( $res );
}
#######################################
=item $boolean = $cfg->merge_config ( $filename[, %override_read_opts] );
Provides a way to merge multiple config files into a single B<Advanced::Config>
object. Useful when the main config file can't source in the passed config
file due to different I<%read_opts> settings, or when a shared config file
can't be modified to source in a sub-config file, or if for some reason you
my $split_ptrn = shift; # The split pattern to use to call to split().
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);
my $value = $self->get_directory ( $tag, $access, $opt_ref );
DBUG_RETURN ( $value ); # An array ref or undef.
}
#######################################
# Private method ...
# Returns (Worked, Hide)
# Caller either wants both values or none of them.
# Should never write to fish ...
sub _base_set
{
my $self = shift;
my $tag = shift;
my $value = shift;
my $file = shift || ""; # The file the tag was defined in.
my $force_sensitive = shift || 0;
my $still_encrypted = shift || 0;
my $has_variables = shift || 0;
# Get the main/parent section to work against!
# my $pcfg = $self->get_section();
my $pcfg = $self->{PARENT} || $self;
# Check if case insensitive handling was requested ...
$tag = lc ($tag) if ( $pcfg->{CONTROL}->{read_opts}->{tag_case} );
if ( $tag =~ m/^shft3+$/i ) {
return ( 0, 0 ); # Set failed ... tag name not allowed.
}
my $hide = ($force_sensitive || $self->{SENSITIVE_SECTION}) ? 1 : 0;
if ( exists $self->{DATA}->{$tag} ) {
$hide = 1 if ( $self->{DATA}->{$tag}->{MASK_IN_FISH} );
} else {
my %data;
$self->{DATA}->{$tag} = \%data;
unless ( $hide ) {
$hide = 1 if ( should_we_hide_sensitive_data ($tag, 1) );
}
}
# The value must never be undefined!
$self->{DATA}->{$tag}->{VALUE} = (defined $value) ? $value : "";
# What file the tag was found in ...
$self->{DATA}->{$tag}->{FILE} = $file;
# Must it be hidden in the fish logs?
$self->{DATA}->{$tag}->{MASK_IN_FISH} = $hide;
# Is the value still encrypted?
$self->{DATA}->{$tag}->{ENCRYPTED} = $still_encrypted ? 1 : 0;
# Does the value still reference variables?
$self->{DATA}->{$tag}->{VARIABLE} = $has_variables ? 1 : 0;
return ( 1, $hide );
}
#######################################
=back
=head2 Manipulating the contents of an Advanced::Config object.
These methods allow you to manipulate the contents of an B<Advanced::Config>
object in many ways. They all just update what's in memory and not the contents
of the config file itself.
So should the contents of this module get refreshed, you will loose any changes
made by these B<4> methods.
=over
=item $ok = $cfg->set_value ( $tag, $value );
Adds the requested I<$tag> and it's I<$value> to the current section in the
I<Advanced::Config> object.
If the I<$tag> already exists, it will be overridden with its new I<$value>.
It returns B<1> on success or B<0> if your request was rejected!
It will also print a warning if it was rejected.
=cut
sub set_value
{
my $self = shift; # Reference to the current section of the object.
my $tag = shift; # The tag set to value ...
my $value = shift;
my ( $worked, $sensitive ) = $self->_base_set ($tag, $value, undef);
DBUG_MASK_NEXT_FUNC_CALL (2) if ( $sensitive );
DBUG_ENTER_FUNC ( $self, $tag, $value, @_ );
unless ( $worked ) {
warn ("You may not use \"${tag}\" as your tag name!\n");
}
DBUG_RETURN ($worked);
}
#######################################
=item $bool = $cfg->rename_tag ( $old_tag, $new_tag );
$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 ...");
my $self = shift;
# The request only applies to the parent instance ...
$self = $self->{PARENT} || $self;
DBUG_RETURN( $self->{CONTROL}->{filename} );
}
#######################################
=item ($ropts, $gopts, $dopts) = $cfg->get_cfg_settings ( );
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 method is frequently called internally if you define any variables inside
your config files when they are loaded into memory.
Variables in the config file are surrounded by anchors such as B<${>nameB<}>.
But it's passed as B<name> without any anchors when this method is called.
The precedence for looking up a variable's value to return is as follows:
0. Is it the special "shft3" variable or one of its variants?
1. Look for a tag of that same name previously defined in the current section.
2. If not defined there, look for the tag in the "main" section.
3. Special Case, see note below about periods in the variable name.
4. If not defined there, look for a value in the %ENV hash.
5. If not defined there, does it represent a special Perl variable?
6. If not defined there, is it a predefined Advanced::Config variable?
7. If not defined there, is it some predefined special date variable?
8. If not defined there, the result is undef.
If a variable was defined in the config file, it uses the tag's value when the
line gets parsed. But when you call this method in your code after the config
file has been loaded into memory, it uses the final value for that tag.
The special B<${>shft3B<}> variable is a way to insert comment chars into a
tag's value in the config file when you can't surround it with quotes. This
variable is always case insensitive and if you repeat the B<3> in the name, you
repeat the comment chars in the substitution.
* a = ${shft3} - Returns "#" for a.
* b = ${SHFT33} - Returns "##" for b.
* c = ${ShFt333} - Returns "###" for c.
* etc ...
And since this variable has special meaning, if you try to define one of the
B<SHFT3> variants as a tag in your config file, or call C<set_value> with it,
it will be ignored and a warning will be printed to your screen!
If the variable had a period (B<.>) in it's name, and it doesn't match anything
(rules 0 to 2), it follows rule B<3> and it treats it as a reference to a tag in
another section. So see F<rule_3_section_lookup> for details on how this works.
This module provides you special predefined variables (rules 5, 6 & 7) to help
make your config files more dynamic without the need of a ton of code on your
end. If you want to override the special meaning for these variables, all you
have to do is define a tag in the config file of the same name to override it.
Or just don't use these variables in the 1st place.
For rule B<5>, the special Perl variables you are allowed to reference are:
B<$$>, B<$0>, and B<$^O>. (Each must appear in the config file as: B<${$}>,
B<${0}> or B<${^O}>.)
For rule B<6>, the predefined module variables are: ${PID}, ${PPID}, ${user},
${hostname}, ${program}, ${flavor} and ${sep} (The ${flavor} is defined by
F<Perl::OSType> and ${sep} is the path separator defined by F<File::Spec>
for your OS.) The final variable ${section} tells which section this variable
was used in.
Finally for rule B<7> it provides some special date variables. See
B<F<Advanced::Config::Options::set_special_date_vars>> for a complete list of
what date related variables are defined. The most useful being ${today} and
${yesterday} so that you can dynamically name your log files
F</my_path/my_log.${today}.txt> and you won't need any special date roll logic
to start a new log file.
=cut
sub lookup_one_variable
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift; # Reference to the current section.
my $var = shift; # The name of the variable, minus the ${...}.
my $pcfg = $self->{PARENT} || $self; # Get the main section ...
# Silently disable calling "die" or "warn" on all get/set calls ...
local $pcfg->{CONTROL}->{get_opts}->{required} = -9876;
my $opts = $pcfg->{CONTROL}->{read_opts};
# Did we earlier request case insensitive tag lookups?
$var = lc ($var) if ( $opts->{tag_case} );
# The default return values ...
my ( $val, $mask_flag, $file, $encrypt_flag ) = ( undef, 0, "", 0 );
if ( $var =~ m/^shft(3+)$/i ) {
# 0. The special comment variable ... (Can't override)
$val = $1;
my $c = $opts->{comment}; # Usually a "#".
$val =~ s/3/${c}/g;
} else {
# 1. Look in the current section ...
( $val, $mask_flag, $file, $encrypt_flag ) = $self->_base_get2 ( $var );
# 2. Look in the parent section ... (if not already there)
if ( ! defined $val && $self != $pcfg ) {
( $val, $mask_flag, $file, $encrypt_flag ) = $pcfg->_base_get2 ( $var );
}
# 3. Look in the requested section(s) ...
if ( ! defined $val && $var =~ m/[.]/ ) {
($val, $mask_flag, $encrypt_flag) = $self->rule_3_section_lookup ( $var );
}
# 4. Look in the %ENV hash ...
if ( ! defined $val && defined $ENV{$var} ) {
$val = $ENV{$var};
$mask_flag = should_we_hide_sensitive_data ($var);
# Record so refresh logic will work when %ENV vars change.
$pcfg->{CONTROL}->{ENV}->{$var} = $val;
}
# 5. Look at the special Perl variables ... (now done as part of 6.)
# 6. Is it one of the predefined module variables ...
# Variables should either be all upper case or all lower case!
# But allowing for mixed case.
if ( ! defined $val ) {
if ( exists $begin_special_vars{$var} ) {
$val = $begin_special_vars{$var};
} elsif ( exists $begin_special_vars{lc ($var)} ) {
$val = $begin_special_vars{lc ($var)};
} elsif ( exists $begin_special_vars{uc ($var)} ) {
$val = $begin_special_vars{uc ($var)};
} elsif ( $var eq "section" ) {
$val = $self->section_name ();
}
}
# 7. Is it one of the special date variables ...
# All these date vars only use lower case!
if ( ! defined $val ) {
my $lc_var = lc ($var);
if ( defined $pcfg->{CONTROL}->{DATES}->{$lc_var} ) {
$val = $pcfg->{CONTROL}->{DATES}->{$lc_var};
# Record so refresh logic will work when the date changes.
# Values:
# 0 - unknown date variable. (so refresh will ignore it.)
# 1 - MM/DD/YYYY referenced. (refresh on date change.)
# 2 - MM or MM/YYYY referenced. (refresh if the month changes.)
# 3 - YYYY referenced. (refresh if the year changes.)
my $rule = 0;
if ( $lc_var =~ m/^((yesterday)|(today)|(tomorrow)|(dow)|(doy)||(dom))$/ ) {
$rule = 1;
} elsif ( $lc_var =~ m/^((last)|(this)|(next))_month$/ ) {
$rule = 2;
} elsif ( $lc_var =~ m/^((last)|(this)|(next))_period$/ ) {
$rule = 2;
} elsif ( $lc_var =~ m/^((last)|(this)|(next))_year$/ ) {
$rule = 3;
}
# Don't record if {timestamp} used. (rule == 0)
# Save the smallest rule referenced ...
if ( $rule != 0 ) {
if ( $pcfg->{CONTROL}->{DATE_USED} == 0 ) {
$pcfg->{CONTROL}->{DATE_USED} = $rule;
} elsif ( $pcfg->{CONTROL}->{DATE_USED} > $rule ) {
$pcfg->{CONTROL}->{DATE_USED} = $rule;
}
}
}
}
# 8. Then it must be undefined ... (IE: an unknown variable)
}
# Mask the return value in fish ???
DBUG_MASK ( 0 ) if ( $mask_flag);
# Is the return value still encryped ???
$mask_flag = -1 if ( $encrypt_flag );
DBUG_RETURN ( $val, $mask_flag )
}
# ==============================================================
=item ($value, $sens, $encrypt) = $cfg->rule_3_section_lookup ( $variable_name );
When a variable has a period (B<.>) in its name, it could mean that this
variable is referencing a tag from another section of the config file. So this
helper method to F<lookup_one_variable> exists to perform this complex check.
For example, a variable called B<${>xxx.extraB<}> would look in Section "xxx"
for tag "extra".
Here's another example with multiple B<.>'s in its name this time. It would
look up variable B<${>one.two.threeB<}> in Section "one.two" for tag "three".
And if it didn't find it, it would next try Section "one" for tag "two.three".
If it found such a variable, it returns it's value. If it didn't find anything
it returns B<undef>. The optional 2nd and 3rd values tells you more about the
( run in 0.775 second using v1.01-cache-2.11-cpan-e1769b4cff6 )