Advanced-Config
view release on metacpan or search on metacpan
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 calcuated 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 behaviour.
F<\%get_opts> is an optional hash reference that defines the default behaviour
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 behaviour.
F<\%date_opts> is an optional hash reference that defines the default formatting
of the special 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 hash references support! Look under the S<I<The Read Options>>,
S<I<The Get Options>>, and S<I<The Date Formatting Options>> sections of the
POD.
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 ...
}
}
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.
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_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 overriden.) Otherwise
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
#######################################
=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;
=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 curent 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;
=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 curent 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;
$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 senitive (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 it's 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 $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 $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.
lib/Advanced/Config/Date.pm view on Meta::CPAN
} elsif ( $in_date =~ m/(^|\D)(\d{8})(\D|$)/ ) {
($year, $month, $day) = parse_8_digit_date ( $2, $date_format_options, 0 );
$fmt = "YYYYMMDD";
# -------------------------------------------------------
# Finally, assume it's using a 2-digit year format ...
# Only if they are allowed ...
# -------------------------------------------------------
} elsif ( $allow_2_digit_years ) {
foreach my $sep ( @seps ) {
next if ( $sep eq ":" ); # Skip, if used it looks like a time of day ...
if ( $in_date =~ m/(^|[^:\d])(\d{1,2})(${sep})(\d{1,2})(${sep})(\d{1,2})([^:\d]|$)/ ) {
($s1, $s2) = ($3, $5);
my $yymmdd = sprintf ("%02d%02d%02d", $2, $4, $6);
($year, $month, $day) = parse_6_digit_date ( $yymmdd, $date_format_options );
$fmt = "YY${s1}MM${s2}DD ???";
# ------------------------------------------------------------------------------------------
} elsif ( $in_date =~ m/(^|\D)(\d{1,2})(${sep})(${name})[.]?(${sep})(\d{1,2})([^:\d]|$)/ &&
exists $Months{lcx($4)} ) {
lib/Advanced/Config/Date.pm view on Meta::CPAN
DBUG_RETURN ( $year );
}
# ==============================================================
=item ($year, $month, $day) = parse_8_digit_date ( $date_str, $order[, $skip] );
Looks for a valid date in an 8 digit string. It checks each of the formats below
in the order specified by I<$order> until it hits something that looks like a
valid date.
(1) YYYYMMDD - ISO
(2) MMDDYYYY - American
(3) DDMMYYYY - European
The I<$order> argument helps deal with ambiguities in the date. Its a comma
seperated list of numbers specifying to order to try out. Ex: 3,2,1 means
try out the European date format 1st, then the American date format 2nd, and
finally the ISO format 3rd. You could also just say I<$order> is B<3> and
only accept European dates.
It assumes its using the correct format when the date looks valid. It does this
by validating the B<MM> is between 1 and 12 and that the B<DD> is between 1 and
31. (Using the correct max for that month). And then assumes the year is
always valid.
If I<$skip> is a non-zero value it will skip over the B<ISO> format if it's
listed in I<$order>.
Returns 3 B<undef>'s if nothing looks good.
=cut
sub parse_8_digit_date
{
DBUG_ENTER_FUNC ( @_ );
my $date_str = shift;
my $order = shift;
my $skip_iso = shift || 0;
lib/Advanced/Config/Date.pm view on Meta::CPAN
DBUG_RETURN ( $year, $month, $day );
}
# ==============================================================
=item ($year, $month, $day) = parse_6_digit_date ( $date_str, $order );
Looks for a valid date in an 6 digit string. It checks each of the formats below
in the order specified by I<$order> until it hits something that looks like a
valid date.
(1) YYMMDD - ISO
(2) MMDDYY - American
(3) DDMMYY - European
The I<$order> argument helps deal with ambiguities in the date. Its a comma
seperated list of numbers specifying to order to try out. Ex: 2,3,1 means
try out the American date format 1st, then the European date format 2nd, and
finally the ISO format 3rd. You could also just say I<$order> is B<2> and
only accept European dates.
So if you use the wrong order, more than likely you'll get the wrong date!
It assumes its using the correct format when the date looks valid. It does this
by validating the B<MM> is between 1 and 12 and that the B<DD> is between 1 and
31. (Using the correct max for that month). And then assumes the year is
always valid.
Returns 3 B<undef>'s if nothing looks good.
It always returns the year as a 4-digit year!
=cut
sub parse_6_digit_date
{
DBUG_ENTER_FUNC ( @_ );
my $date_str = shift;
my $order = shift;
lib/Advanced/Config/Examples.pm view on Meta::CPAN
[ Host 4 ]
user = you
Please note that section names are case insensitive and the tag abc's value
depends on what section of the config file you are currently looking at. This
way you may repeat tags between sections and know that each section is
independant of each other. As if each section was in it's own config file.
Or you can interpret each section as overrides to tags in the main section
using the B<inherit> option. Where if a tag isn't defined in the current
section, it then looks in the main section for it. Say you're on host 1 and
you want to log into your application. You need both a user & pwd pair to do
this. When you look up the pwd, you find it in host 1, but when you try to
look up the user, it can't find it in the current section, so it looks in the
main section for it instead. In effect all 4 sections have all variables from
main included in each section. With the local tags overriding what's in main.
A neet way to handle minor differences that would otherwise require you to
have multiple config files you'd need to keep in sync.
To load it into memory do:
my $cfg = Advanced::config->new ("section.cfg")->load_config();
or
my $cfg = Advanced::config->new ("section.cfg", {inherit => 1})->load_config();
lib/Advanced/Config/Options.pm view on Meta::CPAN
config file is parsed.
After that, where to set the other options is more a personal choice than
anything else.
=over 4
B<inherit> - Defaults to B<0> where each section is independent, the tag either
exists or it doesn't in the section. Set to B<1> if each section should be
considered an override for what's in the main section. IE if tag "abc" doesn't
exist in the current section, it next looks in the main section for it.
B<required> - This controls what happens when the requested tag doesn't exist
in your I<Advanced::Config> object. Set to B<0> to return B<undef> (default),
B<-1> to return B<undef> and write a warning to your screen, B<1> to call
die and terminate your program.
B<vcase> - Controls what case to force all values to. Defaults to B<0> which
says to preserve the case as entered in the config file. Use B<1> to convert
everything to upper case. Use B<-1> to convert everything to lower case.
lib/Advanced/Config/Reader.pm view on Meta::CPAN
my ($l_quote, $r_quote, $tv_pair_flag) = ("", "", 0);
my $var_line = $line;
unless ( defined $tag && defined $value ) {
$tag = $value = undef; # It's not a tag/value pair ...
} elsif ( $tag eq "" || $tag =~ m/${comment}/ ) {
$tag = $value = undef; # It's not a valid tag ...
} else {
# It looks like a tag/value pair to me ...
$tv_pair_flag = 1;
if ( $opts->{disable_quotes} ) {
; # Don't do anything ...
} elsif ( $default_quotes ) {
if ( $value =~ m/^(['"])/ ) {
$l_quote = $r_quote = $1; # A ' or ". (Never both)
}
lib/Advanced/Config/Reader.pm view on Meta::CPAN
my $rOpts = shift;
DBUG_RETURN ( $rOpts->{section_left} . " ${name} " . $rOpts->{section_right} );
}
# ==============================================================
=item $string = format_tag_value_line ( $cfg, $tag, \%rOpts )
It looks up the B<tag> in the I<$cfg> object, then it uses the given
I<Read Options Hash> options to format a tag/value pair string.
=cut
sub format_tag_value_line
{
DBUG_ENTER_FUNC ( @_ );
my $cfg = shift; # An Advanced::Config object reference.
my $tag = shift;
my $rOpts = shift;
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# Replace any problem char for values with escape sequences ...
# ---------------------------------------------------------------
$value =~ s/\\/\\z/sg; # Done so we can use \ as an escape sequence.
$value =~ s/\n/\\n/sg; # Remove embedded "\n" so no mult-lines.
$value =~ s/%/\\p/sg; # So calls to DBUG_PRINT won't barf ...
$value =~ s/${cmt}/\\3/sg; # Don't want any comment chars ...
if ( $rq ) {
$value =~ s/${l_quote}/\\q/sg;
$value =~ s/${r_quote}/\\Q/sg;
}
$value =~ s/${var}/\\v/sg; # So nothing looks like a variable ...
$value =~ s/\0/\\0/sg; # So no embedded null chars ...
DBUG_RETURN ( $value, $lq, $rq );
}
# ==============================================================
# When an encrypted value is read in from the config file, all escape
# secuences need to be removed before the value can be decrypted.
# These escape sequences were required to avoid parsing issues when
t/55-validate-strings.t view on Meta::CPAN
my $str2 = $cfg->decrypt_string ($str1, $alias);
# ----------------------------------------------------------
# Now some more detailed comparisons of the results ...
# ----------------------------------------------------------
my $xCfg1 = init_config ( $original );
my $xCfg2 = init_config ( $str1, $alias ); # Decryption works ...
my $xCfg3 = init_config ( $str1 ); # Decryption fails ...
my $xCfg4 = init_config ( $str2 );
dbug_ok ((defined $str1 && $str1 ne $original), "Encrypting a string looks good!");
dbug_ok ((defined $str2 && $str2 ne $str1), "Decrypting a string looks good!");
my $sxCfg1 = $xCfg1->get_section ($sect);
my $sxCfg2 = $xCfg2->get_section ($sect);
my $sxCfg3 = $xCfg3->get_section ($sect);
my $sxCfg4 = $xCfg4->get_section ($sect);
dbug_ok ( defined $sxCfg1, "Section exists" );
dbug_ok ( defined $sxCfg2, "Section exists" );
dbug_ok ( defined $sxCfg3, "Section exists" );
dbug_ok ( defined $sxCfg4, "Section exists" );
t/config/30-alt_symbol_control.cfg view on Meta::CPAN
# all begin 'section_test_'.
#
# When such tag(s) appear, it's an instruction to compare just that
# one section of the config file to the template. Everything else
# outside that section is ignored.
#
# So if you only have one section to compare, use "section_test_01".
# If you have multiple sections to compare use "section_test_01",
# "section_test_02", etc.
#
# So say section_test_01 = "abc", then it looks up tag "abc" in the
# referenced config file for the name of the section to use. Done like
# this since part of the tests were to use long messy section names
# and this avoided tests failing due to typos.
#
# Please note that sections of the same name are merged together and
# I want to be able to validate that muliple sections map correctly.
#
# ==========================================================================
#
# NOTE: The template file does not use sections! So when compared to a
( run in 0.402 second using v1.01-cache-2.11-cpan-64827b87656 )