Advanced-Config
view release on metacpan or search on metacpan
# At times this might be called after END ...
DESTROY
{
DBUG_ENTER_FUNC ();
DBUG_VOID_RETURN ();
}
# ----------------------------------------------------------------------------
# Helper functions that won't appear in the POD.
# They will all start with "_" in their name.
# But they are still considered members of the object.
# These functions can appear throughout this file.
# ----------------------------------------------------------------------------
# Using Cwd's abs_path() bombs on Windows if the file doesn't exist!
# So I'm doing this conversion myself.
# This function doesn't care if the file actually exists or not!
# It just converts a relative path into an absolute path!
sub _fix_path
{
object.
=over 4
=item $cfg = $cfg->load_config ( [$filename[, %override_read_opts]] );
This method reads the current I<$filename> into memory and converts it into an
object so that you may refrence it's contents. The I<$filename> must be defined
either here or in the call to B<new()>.
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_config> 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.
On success, it returns a reference to itself so that it can be initialized
separately or as a single unit.
}
#######################################
=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.
#######################################
# 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;
}
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)
${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 ...
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
README
full_developer_test.pl.src
lib/Advanced/Config/Date.pm
lib/Advanced/Config/Examples.pm
lib/Advanced/Config/Options.pm
lib/Advanced/Config/Reader.pm
t/00-basic.t
t/01-basic_regexp.t
t/02-basic_parse_line_01_defaults.t
t/02-basic_parse_line_02_overrides.t
t/02-basic_parse_line_03_same_start_stop.t
t/04-basic.t
t/05-basic_use.t
t/06-basic_require.t
t/09-basic_date.t
t/10-validate_simple_cfg.t
t/11-manual_build.t
t/12-validate_sections.t
t/13-alt-get-tests.t
t/15-validate_multi_source_cfg.t
t/20-validate_encrypt_decrypt.t
# This module is a powerful config file manager that treats your config files
# as objects to access. It provides many different features that make it
# more useful than many of the compeating config file modules. And most of its
# features are very configurable to meet your individual needs.
# It's main goal is to be able to take config files from various sources and
# products and to be able to use them natively in this module. Making any
# config file look the same to a Perl program!
# See the many test cases and config files for how powerful things can be.
# Once you start using it I don't see you going back to using any other
# config file module.
# This module makes heavy use of Fred::Fish::DBUG to provide tracing for the
# test cases and to help with debugging this code. But this logging feature is
# turned off for normal operations. But it's still a prerequisite for using
# this module.
# Run "perldoc Advanced::Config::Examples" for more details & examples
# in using Advaned::Config once this module has been installed.
a) Unix: export ADVANCED_CONFIG_FISH=1
b) Windows: set ADVANCED_CONFIG_FISH=1
c) You can also set this variable in your test program's BEGIN block:
$ENV{ADVANCED_CONFIG_FISH} = 1;
Just make sure your BEGIN block appears before you source in
Advanced::Config via: eval "use Advanced::Config";
2) In your code source in the Fred::Fish::DBUG module.
use Fred::Fish::DBUG;
3) Turn on fish logging at the start of your test program:
DBUG_PUSH ("my_fish_log.txt"); # Turns fish on ...
4) Feel free to use the Fred::Fish::DBUG module in your test program as well
to help document the flow of your test code.
Just be aware that turning on this logging can significantly slow down your
program because of all the details being written to the logs by Advanced::Config.
So only set the 'ADVANCED_CONFIG_FISH' environment variable when you really need
to see detailed logging.
lib/Advanced/Config/Date.pm view on Meta::CPAN
$dom =~ s/-//g if ( $last_language_edit_flags{dsuf_hyphin} );
my ( $year, $month, $day );
my ( $s1, $s2 ) = ( "", "" );
my $fmt = "n/a";
# The 7 separators to cycle through to parse things correctly ...
my @seps = ( "-", "/", "[.]", ",", "\\s+", '\\\\', ":" );
# -------------------------------------------------------
# Let's start with the 4-digit year formats ...
# -------------------------------------------------------
foreach my $sep ( @seps ) {
if ( $in_date =~ m/(^|\D)(\d{4})(${sep})(\d{1,2})(${sep})(\d{1,2})(\D|$)/ ) {
( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
$fmt = "YYYY${s1}MM${s2}DD"; # ISO format
} elsif ( $in_date =~ m/(^|\D)(\d{1,2})(${sep})(\d{1,2})(${sep})(\d{4})(\D|$)/ ) {
( $month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );
( $year, $month, $day ) = parse_8_digit_date ( sprintf ("%02d%02d%04d", $month, $day, $year),
$date_format_options, 1 );
lib/Advanced/Config/Date.pm view on Meta::CPAN
}
# ==============================================================
=back
=head1 SOME EXAMPLE DATES
Here are some sample date strings in B<English> that this module can parse.
All for Christmas 2017. This is not a complete list of available date formats
supported. But should hopefully give you a starting point of what is possible.
Remember that if a date string contains extra info arround the date part of it,
that extra information is thrown away.
S<12/25/2017>, B<S<Mon Dec 25th 2017 at 09:00>>, S<Mon 2017/12/25>, B<S<2017-12-25>>,
S<Monday December 25th, 2017 at 09:00>, B<S<12.25.2017>>, S<25-DEC-2017>,
B<S<25-DECEMBER-2017>>, S<20171225>, B<S<12252017>>,
S<Mon dec. 25th 00:00:00 2017>, B<S<2017 12 25 mon>>.
Most of the above examples will also work with 2-digit years as well.
lib/Advanced/Config/Examples.pm view on Meta::CPAN
In many cases it's just easier to show an example instead of trying
to put things into words. So this module is just some POD text to document
what this module is expecting to load into memory as your config file.
Just be aware that it's possible to override many of the operators defined in
the config file. So for example the B<=> operator could be B<:=> and the
B<#> operator could have been B<CMT:>.
=head1 HISTORY
This module started out as a parser of unix shell script data files so that
shell scripts and perl programs could share the same config files. Hence the
support of shell script variables, quotes and the sourcing in of sub-files.
Allowing for limited logic in your config files.
From there it just grew to support non-unix features such as windows batch
files and more generic configuation features. Such as being able handle various
formating of config files and the ability to obscure or encrypt values from
casual snooping. Or the addition of sections to allow the same config file to
be used on multiple servers and OS.
lib/Advanced/Config/Options.pm view on Meta::CPAN
Internal spaces are OK when non-numeric values are expected. In most cases
values with a length of B<0> or B<undef> are not allowed.
Just be aware that some combinations of I<Read> options may result in this
module being unable to parse the config file. If you encounter such a
combination open a CPAN ticket and I'll see what I can do about it. But some
combinations may just be too ambiguous to handle.
Also note that some I<Read> options have B<left> and B<right> variants. These
options are used in pairs and both must anchor the target in order for the rule
to be applied to it. These start/end anchors can be set to the same string or
different strings. Your choice.
=head2 Tag(s) Best Set in Call to the Constructor new().
While not required to set these options during the call to B<new>, changing
their settings later on can cause unexpected issues if you are not careful.
But it's still recommended that most I<Read> Options be set during the call to
B<new> to avoid having to keep on resetting them all the time and limit these
later changes to handle exceptions to your defaults.
lib/Advanced/Config/Options.pm view on Meta::CPAN
B<assign> - Defaults to B<=>. You may use this option to override what string
of characters make up the assignemnt operator. It's used to split a line
into a tag/value pair. If you want the special case of no separator, IE the
first space separates a tag/value pair, try setting it to B<\\s> since the
interface doesn't allow whitespace as a value.
B<comment> - Defaults to B<#>. This is the comment symbol used when parsing
your config file and everything after it is ignored in most cases. The first
case is when it appears between balanced quotes as part of a tag's value, it's
not considered the start of a comment. The other case is when you put one
of the labels in the comments to override default behavior. (See next section)
B<source> - Defaults to "B<.>". When followed by a file name, this is an
instruction to source in another config file (similar to how it works in a
I<Unix> shell script.) Another common setting for this option is "include".
B<section_left> & B<section_right> - This pair is used to anchor breaking
your config file into multiple independant sections. The defaults are B<[>
and B<]>.
lib/Advanced/Config/Options.pm view on Meta::CPAN
$default_read_opts{disable_decryption} = 0; # Don't disable decryption!
# $default_read_opts{enable_backquotes} = 0; # Don't allow random command execution.
$default_read_opts{trap_recursion} = 0; # Recursion is ignored, not fatal
$default_read_opts{source_cb} = __PACKAGE__->can ("_source_callback_stub");
$default_read_opts{source_cb_opts} = \%src_empty;
# The file parsing options ...
$default_read_opts{assign} = '='; # The assignment operator
$default_read_opts{comment} = '#'; # The comment symbol
$default_read_opts{source} = '.'; # The file source symbol
$default_read_opts{section_left} = '['; # The start section string
$default_read_opts{section_right} = ']'; # The end section string
$default_read_opts{variable_left} = '${'; # The start variable string
$default_read_opts{variable_right} = '}'; # The end variable string
# Unlikely default values due to security concerns.
# $default_read_opts{backquote_left} = '`'x101; # The start backquote string
# $default_read_opts{backquote_right} = '`'x102; # The end backquote string
# The quote chars ... (Special case doesn't work for anything else.)
# See using_default_quotes() if this changes ...
$default_read_opts{quote_left} = $default_read_opts{quote_right} = "['\"]";
# The tag/value modifiers. These labels are found inside the comments!
$default_read_opts{export_lbl} = "EXPORT"; # Label for a single %ENV.
$default_read_opts{hide_lbl} = "HIDE"; # Mark as sensitive.
$default_read_opts{encrypt_lbl} = "ENCRYPT"; # Pending encryption.
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$var_line = $value;
}
# Comment still in value, but still haven't proved any quotes are balanced.
DBUG_PRINT ("DEBUG", "Tag (%s), Value (%s), Proposed Left (%s), Right (%s)",
$tag, $value, $l_quote, $r_quote);
my $cmts = "";
# Was the value in the tag/value pair starting with a left quote?
if ( $tv_pair_flag && $l_quote ne "" ) {
my ($q1, $val2, $q2);
# Now check if they were balanced ...
if ( $value =~ m/^(${l_quote})(.*)(${r_quote})(\s*${comment}.*$)/ ) {
($q1, $val2, $q2, $cmts) = ($1, $2, $3, $4); # Has a comment ...
} elsif ( $value =~ m/^(${l_quote})(.*)(${r_quote})\s*$/ ) {
($q1, $val2, $q2, $cmts) = ($1, $2, $3, ""); # Has no comment ...
}
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$mod_opt, $mod_val, $regExpVal, $reverse_msg, $output);
} elsif ( $mod_opt eq "LENGTH" ) {
$output = length ( $alt_val );
DBUG_PRINT ("MOD", "Setting the length of variable \${#%s} to: %d.",
$mod_tag, $output);
} elsif ( $mod_opt eq "LIST" ) {
my @lst = $cfg->_find_variables ( $mod_val );
$output = join (" ", @lst);
DBUG_PRINT ("MOD", "Getting all varriables starting with %s", $mod_val);
} elsif ( $mod_opt eq "!" ) {
($output, $mask) = $cfg->lookup_one_variable ( $alt_val );
if ( $mask == -1 ) {
$mask = -2; # Indirect reference to encrypted value
$output = $alt_val; # Replace with new variable name
} elsif ( $mask ) {
DBUG_MASK (0);
}
DBUG_PRINT ("MOD", "Indirectly referencing variable %s (%s)", $alt_val, $mask);
t/02-basic_parse_line_03_same_start_stop.t view on Meta::CPAN
# The Variable Replacement Tests ...
parse_tv ("Var-1", 'Help me with %var1% resolve!', "");
parse_tv ("Var-2", 'Help me with %var2% resolve!', "A constant");
parse_tv ("Var-3", 'Help me with %var3% resolve!', 'A %variable%');
parse_tv ("Var-4", 'Help me with %var4% & %var5% resolve!', 'A %var1% %var2%');
# Using the wrong anchors for Variable replacements ...
parse_tv ("Old-1", 'Help me with ${var3} resolve!', 'A ${variable}');
# NOTE: These variable substitution tests are drastically differnt than
# the other 2 test scripts since when the start/stop anchors are
# the same, the available functionality is drastically reduced!
# Such as no more nested variable substitutions.
# And no support for variable modifiers since many of them would
# corrupt the variable definition!
# NOTE: Errors only occur in these tests if there are comments with variables
# defined in them!
# Corrupted Variable definitions ...
parse_tv ("Var-Unbal-0", 'Want % %help% %with% %this% %mess%?', 'Static Comment');
t/02-basic_parse_line_03_same_start_stop.t view on Meta::CPAN
dbug_is ( $comment, $cmt, "The comment was stripped out OK! ($cmt)" );
dbug_ok (1, "-"x60);
# Returns the number of tests executed ...
DBUG_RETURN (6);
}
# -----------------------------------------------
# Does between 1 & 6 tests.
# These are failure tests for when the start/stop variable anchors are
# the same string. The parsing fails only when there are variable anchors
# in the comment itself. Just no way to get arround that issue!
sub parse_tv_error
{
DBUG_ENTER_FUNC (@_);
my $tag = shift;
my $value = shift;
my $comment = shift;
t/20-validate_encrypt_decrypt.t view on Meta::CPAN
use helper1234;
my $fish;
# =================================================================
# Tests the encryption/decryption logic.
# =================================================================
# Assumptions about the config files made by this test program:
# If any assumtions are false, you will see test failures.
# 1) No tag appeears in multiple sections for this test.
# 2) All tags starting with "join" are assumed to reference
# encrypted variables/tags.
# =================================================================
BEGIN {
$fish = turn_fish_on_off_for_advanced_config ();
unlink ( $fish );
DBUG_ENTER_FUNC ();
t/40-validate-modifiers.t view on Meta::CPAN
my $a2Msg = "in what you accept, and conservative in what you send.";
my $c2Msg = "Be liberal in what you accept, and conservative in what";
my $e2Msg = "liberal";
my $sub1 = $Msg; $sub1 =~ s/in/by/;
my $sub2 = $Msg; $sub2 =~ s/in/by/g;
my $sub5 = $Msg; $sub5 =~ s/in//;
my $sub6 = $Msg; $sub6 =~ s/in//g;
# Get all variables starting with "y" ...
# Need in case your environment contains unexpected ${y...} vars.
my %l;
foreach ( "yellow", "yesterday", keys %ENV ) {
$l{$_} = 2 if ( $_ =~ m/^y/ );
}
my $lst = join (" ", sort keys %l);
my %values = ( "msg" => $Msg,
"a" => $aMsg,
"b" => $bMsg,
t/70-validate_date_vars.t view on Meta::CPAN
use File::Spec;
use Sys::Hostname;
use Fred::Fish::DBUG 2.09 qw / on /;
use Fred::Fish::DBUG::Test 2.09;
# How to find the helper module ...
BEGIN { push (@INC, File::Spec->catdir (".", "t", "test-helper")); }
use helper1234;
# ---------------------------------------------------------------------
# Shows what happens when you start monkeying arround with the special
# date variables ...
# ---------------------------------------------------------------------
# Warning: Some tests will fail if this program starts before midnight
# and finishes after midnight. So all tests are disabled
# starting at 11:58 PM.
# ---------------------------------------------------------------------
my $fish;
BEGIN {
$fish = turn_fish_on_off_for_advanced_config ();
unlink ( $fish );
DBUG_ENTER_FUNC ();
t/config/40-validate-modifiers.cfg view on Meta::CPAN
alt2 = ${d:+Overriding a value is fun!} # "Overriding a value is fun!"
alt3 = ${abcd:+${dnu}!} # ""
alt4 = ${xyz:+${dnu}!} # ""
alt5 = ${unknown+${dnu}!} # ""
alt6 = ${d+Overriding a value is fun!} # "Overriding a value is fun!"
alt7 = ${abcd+${dnu}!} # "Do not use!"
alt8 = ${xyz+${dnu}!} # ""
# ---------------------------------------------------------------------------
# Gets the list of variables starting with "y" ...
yellow = bass
list1 = ${!y*}
list2 = ${!y@}
# Indirect variable look ups.
bass = is a fish
indirect1 = ${!yellow} # Should say "is a fish"!
indirect2 = ${!YELLOW} # Should say ""!
book = Chapter123
( run in 0.391 second using v1.01-cache-2.11-cpan-0d8aa00de5b )