Advanced-Config
view release on metacpan or search on metacpan
- Examples.pm - Added encrypt/decrypt example config file.
- Fixed t/13-alt-get-tests.t to explicitly use "date_format => 3" instead of
relying on it to remain the default value for this option for these date
tests to work in the future.
- Added clarification that the # char is only special to Test::More::ok in
t/01-basic_regexp.t, not for RegExpr.
Never uploaded to CPAN.
1.03 2019-03-06 08:30:00
- Updated the VERSION in all *.pm files.
- Fixed some POD formatting errors in Options.pm
- Fixed some POD typos in Reader.pm
- Fixed some POD typos in Date.pm
- Fixed 2 digit year bug in parse_date() in Date.pm, parsing two digit years
are still problematic and quite frequently ambiguous.
- More enhancements for parsing 2 & 4 digit year dates in parse_date().
- Added more date tests in t/09-basic_date.t to further test various date
formats.
- Advanced::Config::Options now disallows 2 digit year dates by default
due to the ambiguity involved in trying to parse them. Also updated
the POD to say so in Date.pm & Options.pm.
during all calls to get_date() to allow 2-year dates in the tests!
- Fixed t/t/09-basic_date.t to explicitly allow 2-year dates in it's
tests as well.
- Added option date_dl_conversion to allow the use of Date:Language:str2time()
to optionally enhance parse_date().
- Fixed bug in the dynamic DBUG/DBUG::OFF module selection in all module BEGIN
blocks.
Never uploaded to CPAN.
1.02 2019-01-08 08:30:00
- Corrected some significant errors in the POD text.
- Added some usage errors in move_tag, rename_tag, and delete_tag.
- Merged rule 5 & 6 tests in lookup_one_variable(). But left
separate in POD.
- Added toHash() method to convert object into a hash.
- Fixed sensitive bug in Options.pm.
- Now uses DBUG's built in argument masking method instead of hacking the
code to enforce masking. Enables us to put the arguments in a more sane
order in the future and eliminated convoluted code for masking what wasn't
needed for module functionality.
- Updated min version of DBUG allowed in Makefile.PL so previous fix works!
(version: 1.03)
- Fixed jan/dec bug in Options.pm for next/previous month check.
- t/00-basic.t now uses BAIL_OUT() to force "make test" to abort if
it hits compile errors with my module. Makes it easier to debug
changes.
- Added test case dependencies to Makefile.PL
Never uploaded to CPAN.
1.01 2018-08-06 08:30:00
- Prepping for an Initial Public Release from a private personal baseline.
Never uploaded to CPAN.
this, you will require the use of the I<alias> option to be able to decrypt
it again using the new name. This file only gets created if the return status
is B<1>.
If you leave off the I<$file> and I<\%rOpts>, it will instead use the values
inherited from the call to B<new>.
This method ignores any request to source in other config files. You must
encrypt each file individually.
It is an error if basename(I<$file>) is a symbolic link and you didn't provide
I<$encryptFile>.
Returns: B<1> if something was encrypted. B<-1> if nothing was encrypted.
Otherwise B<0> on error.
=cut
sub encrypt_config_file
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $file = shift;
my $newFile = shift;
my $rOpts = shift;
} else {
$rOpts = $pcfg->{CONTROL}->{read_opts};
}
if ( $msg ) {
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, 0 ) );
}
my $status = encrypt_config_file_details ($file, $scratch, $rOpts);
# Some type of error ... or nothing was encrypted ...
if ( $status == 0 || $status == -1 ) {
unlink ( $scratch );
# Replacing the original file ...
} elsif ( ! $newFile ) {
unlink ( $file );
move ( $scratch, $file );
}
DBUG_RETURN ( $status );
Finally if you provide argument I<$decryptFile>, it will write the decrypted
file to that new file instead of overwriting the current file. This file only
gets created if the return status is B<1>.
If you leave off the I<$file> and I<\%rOpts>, it will instead use the values
inherited from the call to B<new>.
This method ignores any request to source in other config files. You must
decrypt each file individually.
It is an error if basename(I<$file>) is a symbolic link and you didn't provide
I<$decryptFile>.
Returns: B<1> if something was decrypted. B<-1> if nothing was decrypted.
Otherwise B<0> on error.
=cut
sub decrypt_config_file
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $file = shift;
my $newFile = shift;
my $rOpts = shift;
} else {
$rOpts = $pcfg->{CONTROL}->{read_opts};
}
if ( $msg ) {
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, undef ) );
}
my $status = decrypt_config_file_details ($file, $scratch, $rOpts);
# Some type of error ... or nothing was decrypted ...
if ( $status == 0 || $status == -1 ) {
unlink ( $scratch );
# Replacing the original file ...
} elsif ( ! $newFile ) {
unlink ( $file );
move ( $scratch, $file );
}
DBUG_RETURN ( $status );
lib/Advanced/Config/Examples.pm view on Meta::CPAN
you might expect. It's the relative path from the location of the config file
doing the sourcing, not the current directory your program is running in.
This way the writer of the config file, not the programmer, controls which
config file gets sourced in. Of course the config file writer can give control
back to the programmer by using variables as part of the name of the config
file being sourced in.
If recursion is detected, this module silently refuses to reload the problem
config file and breaks the recursion. But you have the option of treating it
as a fatal error instead. Recursion is detected even if you source in a
symbolic link back to the original file.
It is always a fatal error if the requested config file doesn't exist!
=head1 CONTROLLING THE PARSING OF YOUR CONFIG FILES
See I<The Read Options> section of L<Advanced::Config::Options> for what options
are available for customizing how your configuration files gets parsed.
While I<The Get Options> section covers options for looking up the value for
a given tag generated.
=head1 ENCRYPTING VALUES IN YOUR CONFIG FILE
lib/Advanced/Config/Options.pm view on Meta::CPAN
=back
=head2 Generic Read Options
These options are also usually set during the call to B<new>, but setting them
later on doesn't produce strange behavior if you change the settings later on.
=over 4
B<croak> - This controls what happens when a function hits an unexpected error
while parsing the config file. Set to B<0> to return an error code (default),
B<-1> to return an error code and print a warning to your screen, B<1> to call
die and terminate your program.
B<export> - Tells if we should export all tag/value pairs to perl's %ENV hash
or not. The default is B<0> for I<No>. Set to B<1> if you want this to happen.
But if set, it reverses the meaning of the B<export_lbl> option defined later
on.
B<use_utf8> - Defaults to B<0>. Set to B<1> if the config file was created
using utf8 encoding. (IE Unicode or Wide Characters.) Guessing this
setting wrong means the file will be unusable as a config file.
lib/Advanced/Config/Options.pm view on Meta::CPAN
=cut
# B<enable_backquotes> - Defaults to B<0>. Set to B<1> if you want to enable
# this feature. It's disabled by default since it can be considered a security
# hole if an unauthorized user can modify your config file or your code.
=pod
B<trap_recursion> - Defaults to B<0>. Set to B<1> if you want to treat
recursion as a fatal error when loading a config file. By default it just
ignores the recursion request to prevent infinite loops.
B<source_cb_opts> - A work area for holding values between calls to the
callback function. This is expected to be a hash reference to provide any
needed configuration values needed to parse the next config file. This way
you can avoid global varibles. Defaults to an empty hash reference.
B<source_cb> - An optional callback routine called each time your config file
sources in another config file. It's main use is when the I<Read Options>
and/or I<Date Format Options> required to parse each config file change between
lib/Advanced/Config/Options.pm view on Meta::CPAN
sub sensitive_cnt
{
DBUG_ENTER_FUNC ( @_ );
DBUG_RETURN ( scalar (@hide_from_fish) );
}
# ==============================================================
=item @ret = croak_helper ($opts, $croak_message, @croak_return_vals)
This helper method helps standardises what to do on fatal errors when reading
the config file or what to do if you can't find the tag on lookups.
It knows I<\%opts> is a "Read" option hash if B<croak> is a member and it's
a "Get" option hash if B<required> is a member. Both options use the same
logic when called.
See B<croak> and B<required> on what these options do.
Returns whatever I<@croak_return_vals> references. It may be a single value or
an array of values.
lib/Advanced/Config/Reader.pm view on Meta::CPAN
if ( $cmt =~ m/(^|${lbl_sep})${hide_str}(${lbl_sep}|$)/ ||
should_we_hide_sensitive_data ( $section ) ) {
$hide_section{$section} = 1;
}
next;
}
# Don't know what the config file was thinking of ...
# Don't bother expanding any variables encountered.
DBUG_PRINT ("error", "<Previous line ignored. Unknown format!>");
next;
}
# ------------------------------------------------------------------
# If you get here, you know it's a tag/value pair to parse ...
# Don't forget that any comment can include processing instructions!
# ------------------------------------------------------------------
# Go to the requested section ...
$cfg = $pcfg->get_section ( $section, 1 );
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$file = $pcfg->_fix_path ( $file, dirname ( $old_file ) );
unless ( -f $file && -r _ ) {
my $msg = "No such file to source in or it's unreadable ( $file )";
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, 0 ) );
}
if ( $cfg->_recursion_check ( $file ) ) {
my $msg = "Recursion detected while sourcing in file ( $new_file )";
if ( $rOpts->{trap_recursion} ) {
# The request is a fatal error!
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, 0 ) );
} else {
DBUG_PRINT ("RECURSION", $msg);
return DBUG_RETURN ( 1 ); # Just ignore the request ...
}
}
# The returned callback option(s) will be applied to the current
# settings, not the default settings if not a compete set!
my ($r_opts, $d_opts);
lib/Advanced/Config/Reader.pm view on Meta::CPAN
( $mod_opt =~ m/^[-=?]$/ && ! defined $value ) ) {
$output = $mod_val; # Now uses this value as it's default!
if ( $mod_opt eq ":=" || $mod_opt eq "=" ) {
# The variable either doesn't exist or it resolved to "".
# This variant rule says to also set the variable to this value!
$cfg->_base_set ( $mod_tag, $output, $file );
} elsif ( $mod_opt eq ":?" || $mod_opt eq "?" ) {
# In shell scripts, ":?" would cause your script to die with the
# default value as the error message if your var had no value.
# Repeating that logic here.
my $msg = "Encounterd undefined variable ($mod_tag) using shell modifier ${mod_opt}";
$msg .= " in config file: " . basename ($file) if ( $file ne "" );
DBUG_PRINT ("MOD", $msg);
die ( basename ($0) . ": ${mod_tag}: ${output}.\n" );
}
DBUG_PRINT ("MOD",
"The modifier (%s) is overriding the variable with a default value!",
$mod_opt);
lib/Advanced/Config/Reader.pm view on Meta::CPAN
encrypted values.
This method ignores any request to source in other config files. You must
encryt each file individually.
It writes the results of the encryption process to I<$writeFile>.
See L<Advanced::Config::Options> for some caveats about this process.
Returns: B<1> if something was encrypted. B<-1> if nothing was encrypted.
Otherwise B<0> on error.
=cut
sub encrypt_config_file_details
{
DBUG_ENTER_FUNC ( @_ );
my $file = shift;
my $scratch = shift;
my $rOpts = shift;
lib/Advanced/Config/Reader.pm view on Meta::CPAN
fail.
This method ignores any request to source in other config files. You must
decrypt each file individually.
It writes the results of the decryption process to I<$writeFile>.
See L<Advanced::Config::Options> for some caveats about this process.
Returns: B<1> if something was decrypted. B<-1> if nothing was decrypted.
Otherwise B<0> on error.
=cut
sub decrypt_config_file_details
{
DBUG_ENTER_FUNC ( @_ );
my $file = shift;
my $scratch = shift;
my $rOpts = shift;
t/02-basic_parse_line_03_same_start_stop.t view on Meta::CPAN
# 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');
parse_tv ("Var-Unbal-0", 'Want % %help% %with% %this% %mess%?', "");
parse_tv_error ("Var-Unbal-1", 'Want % %help% %with% %this% %mess%?', '%Dynamic% %Comment%');
parse_tv_error ("Var-Unbal-2", 'Want %help% %with% %this% %mess% %?', '%Dynamic% %Comment%');
parse_tv_error ("Var-Unbal-3", 'Want %help% %with% % %this% %mess%?', '%Dynamic% %Comment%');
# Corrupted Variable definitions between balanced quotes ...
# This will parse correctly!
parse_tv ("Var-Quotes-0", '|Want % %help% %with% %this% %mess%?|', '%Dynamic% %Comment');
parse_tv ("Var-Quotes-1", '|Want %help% %with% % %this% %mess%?|', '%Dynamic% %Comment');
parse_tv ("Var-Quotes-2", '|Want %help% %with% %this% %mess%? %|', '%Dynamic% %Comment');
# Missing Variable definitions ...
parse_tv ("Missing-1", 'Help %% me', 'Please! %%.');
parse_tv ("Missing-2", 'Help % % again', 'Or Not! % %.');
t/02-basic_parse_line_03_same_start_stop.t view on Meta::CPAN
# 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;
# Build the line from it's parts. So can compare against later.
# Simulates reading a line from a config file ...
my $line = ${tag} . " " . $opts->{assign} . " " . $value;
if ( $comment ) {
$line .= " " . $opts->{comment} . " " . $comment;
} else {
dbug_ok (0, "Programming error: Test requires a comment!");
return DBUG_RETURN (1);
}
unless ( $comment =~ m/${anchor}/ ) {
dbug_ok (0, "Programming error: Test requires a variable anchor in the comment!");
}
# Trim so we can use these values to predict the results ...
$tag = trim ($tag);
$value = trim ($value);
$comment = trim ($comment);
dbug_ok (1, "Test: " . $line);
my ($tv, $data, $cmt, $lq, $rq) = parse_line ( $line, $opts );
unless ( $lq eq "" && $rq eq "" ) {
dbug_ok (0, "Programming error: Unexpected balanced quotes!");
return DBUG_RETURN (1);
}
dbug_ok ( $tv, "It's a tag/value pair!" );
my $tag_msg = "The tag was split out correctly!";
my $val_msg = "As expected, the value didn't parse out correctly!";
if ( $tv ) {
my ( $tg, $val ) = split (/\s*${assign}\s*/, $data, 2);
t/55-validate-strings.t view on Meta::CPAN
my $dst = shift;
my $good = shift; # Array of tags that should match
my $bad = shift; # Array of tags that shouldn't match
unless ( defined $src && defined $dst ) {
return DBUG_RETURN (0);
}
DBUG_PAUSE ();
# It's a fatal error if any tag in the "good" array doesn't exist!
my $ok = 1;
foreach ( @{$good} ) {
my $s = $src->get_value ($_);
my $d = $dst->get_value ($_);
if ( $s ne $d ) {
$ok = 0;
dbug_ok (0, "Tags $_ doesn't match! (${s} vs ${d})");
}
}
# It's a fatal error if any tag in the "bad" array doesn't exist!
foreach ( @{$bad} ) {
my $s = $src->get_value ($_);
my $d = $dst->get_value ($_);
if ( $s eq $d ) {
$ok = 0;
dbug_ok (0, "Tags $_ match when they shouldn't! (${s})");
}
}
DBUG_RETURN ( $ok );
t/55-validate-strings.t view on Meta::CPAN
dbug_is ($cnt1, $cnt2, "The object has the correct number of tags in it! ($cnt1 vs $cnt2)");
# Checks to see if there were any tags in the string that wasn't in %Config.
foreach ( @lst2 ) {
unless ( exists $Config{$_} ) {
dbug_ok (0, "Found tag $_ in the %Config hash!");
}
}
# Only prints out errors. Otherwise over 1,000 tests printed out.
foreach ( @lst1 ) {
unless ( exists $val2{$_} ) {
dbug_ok ( 0, "Tag $_ exists in the string config file!");
next;
}
# Some Config values are undefined ...
unless ( defined $Config{$_} ) {
if ( $val2{$_} ne "undef" ) {
dbug_ok ( 0, "Tag $_ is set to 'undef'. ($val2{$_})");
t/55-validate-strings.t view on Meta::CPAN
sub init_config
{
DBUG_ENTER_FUNC ( @_ );
my $in_string = shift || config_sh ();
my $alias = shift;
my $extra = shift;
my $cfg;
my ( %rOpts, %gOpts, %dOpts );
$rOpts{Croak} = 1; # Call die on error.
$gOpts{Required} = 1; # Call die if the tag doesn't exist.
# Did we ask to change some defauls?
if ( $extra ) {
$rOpts{Comment} = "//";
$rOpts{Assign} = ":=:";
# Commented out on purpose ...
# $rOpts{encrypt_lbl} = "Some Comments ...";
}
t/56-tohash.t view on Meta::CPAN
# ====================================================================
sub init_config
{
DBUG_ENTER_FUNC ( @_ );
my $in_string = shift;
my $cfg;
my ( %rOpts, %gOpts, %dOpts );
$rOpts{Croak} = 1; # Call die on error.
$gOpts{Required} = 1; # Call die if the tag doesn't exist.
# Did we override the read options to use with the string?
my %oOpts;
eval {
$cfg = Advanced::Config->new (undef, \%rOpts, \%gOpts, \%dOpts);
dbug_isa_ok ($cfg, 'Advanced::Config');
my $ldr = $cfg->load_string ( $in_string, \%oOpts );
dbug_ok (defined $ldr, "Advanced::Config contents have been loaded into memory!");
t/75-check_all_languages.t view on Meta::CPAN
my $cfg = shift;
my $pause = shift;
DBUG_PAUSE () if ( $pause );
DBUG_RETURN ( $cfg->load_config () );
}
# --------------------------------------------------------------------
# Compares 2 Advanced::Config objects and verify they are the same!
# Stops on any error encountered.
# --------------------------------------------------------------------
sub compare_objects
{
DBUG_ENTER_FUNC (@_);
my $cfg_src = shift;
my $cfg_dst = shift;
DBUG_PAUSE () unless ( $run_as_developer );
my @src = $cfg_src->find_sections ();
t/75-check_all_languages.t view on Meta::CPAN
$MoY = uc ($def->{MoY}->[$month - 1]);
$DoM = $day . uc ( $def->{Dsuf}->[$day] || "" );
$str = sprintf (" %04d-%02d-%02d = %s %s, %02d # ENCRYPT\n",
$year, $month, $day, $MoY, $DoM, $year % 100);
} elsif ( $mode == 3 ) {
$MoY = lc (uc ($def->{MoYs}->[$month - 1]));
$str = sprintf (" %04d-%02d-%02d = %02d-%s-%02d # ENCRYPT\n",
$year, $month, $day, $day, $MoY, $year % 100);
# The error case that should never happen ....
} else {
$str = sprintf (" %04d-%02d-%02d = Programming errror!",
$year, $month, $day,);
}
# Only happens with bad language definitions ...
unless ( $MoY ) {
DBUG_PRINT ("ERROR", "MoY is null for '%s'. mode: %d\n%s", $lang, $mode, $str);
}
t/76-check_all_languages2.t view on Meta::CPAN
my $cfg = shift;
my $pause = shift;
DBUG_PAUSE () if ( $pause );
DBUG_RETURN ( $cfg->load_config () );
}
# --------------------------------------------------------------------
# Compares 2 Advanced::Config objects and verify they are the same!
# Stops on any error encountered.
# --------------------------------------------------------------------
sub compare_objects
{
DBUG_ENTER_FUNC (@_);
my $cfg_src = shift;
my $cfg_dst = shift;
DBUG_PAUSE () unless ( $run_as_developer );
my @src = $cfg_src->find_sections ();
t/76-check_all_languages2.t view on Meta::CPAN
$MoY = uc ($def->{MoY}->[$month - 1]);
$DoM = $def->{Dsuf}->[$day] || "";
$str = sprintf (" %04d-%02d-%02d = %s %s, %02d # ENCRYPT\n",
$year, $month, $day, $MoY, $DoM, $year % 100);
} elsif ( $mode == 3 ) {
$MoY = lc (uc ($def->{MoYs}->[$month - 1]));
$str = sprintf (" %04d-%02d-%02d = %02d-%s-%02d # ENCRYPT\n",
$year, $month, $day, $day, $MoY, $year % 100);
# The error case that should never happen ....
} else {
$str = sprintf (" %04d-%02d-%02d = Programming errror!",
$year, $month, $day,);
}
return ( $str );
}
# ====================================================================
# So uc() & lc() works agaisnt each key value ...
sub fix_key
t/99-failure.t view on Meta::CPAN
use File::Basename;
use File::Spec;
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;
# Only present to fully test out full_developer_test.pl.src ...
# Used by that program to test out error reporting in various combinations.
BEGIN {
my $fish = turn_fish_on_off_for_advanced_config ();
unlink ( $fish );
# Turn fish on ...
DBUG_PUSH ( $fish );
DBUG_ENTER_FUNC ();
t/config/40-validate-modifiers.cfg view on Meta::CPAN
sub_13 = ${sub_09/%x} # Result: xxx xxxx
# Parsing sub-strings from a longer string ...
# Putting between quotes so leading/trailing spaces are preserved.
sub_14 = "${msg:34}" # Result: " conservative in what you send."
sub_15 = "${msg:34:13}" # Result: " conservative"
sub_16 = '${msg: -11:5}' # Result: 't you'
sub_17 = "${msg:(-11):5}" # Result: "t you"
sub_18 = "${msg:11:-18}" # Result: "in what you accept, and conservative"
sub_19 = "${msg:(-2):-1}" # Result: "d"
sub_20 = "${msg:(-2):-3}" # Result: "" (an error in bash)
sub_21 = "${msg:34:0}" # Result: ""
# ---------------------------------------------------------------------------
# An exersise in shifting case in a string ...
xcase_00 = "ThIs Is OnE fInE mEsS wE'rE iN!"
xcase_00_opt = "^^"
xcase_01 = ${xcase_00~~} # Result: Reverses the case of the entire string!
xcase_02 = ${xcase_00~} # Result: Reverses the case of the 1st char in the string!
( run in 0.328 second using v1.01-cache-2.11-cpan-65fba6d93b7 )