Advanced-Config
view release on metacpan or search on metacpan
# See the README files for more details on this.
#
# To turn fish back off, reset this variable to zero!
# --------------------------------------------------------------------
Version - YYYY/MM/DD
---------------------
1.12 2025-02-06 08:30:00
- Fixed typo in POD link in Date.pm.
- Fixed t/70-validate_date_vars.t to handle timestamp test on even slower
running machines. Increased delay allowed from 20 sec to 2 min & modified
test msg to say how close it is. Grabbing the current timestamp during the
test is proving problematic. (Problem is with the test, not the module.)
1.11 2025-01-29 08:30:00
- Fixed t/70-validate_date_vars.t to handle timestamp test on slow running
machines.
- Fixed t/10-validate_simple_cfg.t to properly get the userid for all
platforms.
1.10 2025-01-01 08:30:00
- Fixed so minimum version of 2.08 required for using Fred::Fish::DBUG.
So it's limitations with earlier Perl versions wouldn't affect this one.
- Updated copyrights to 2024 on all files, both *.PM & t/*.t.
- Fixed t/75-check_all_languages.t to ignore buggy language definitions.
- Fixed t/75-check_all_languages.t & t/76-check_all_languages2.t to
make sure it creates the fish log before it tries to load optional
modules. So the developer tests will find the proper number of
and date formats allowed.
- t/76-check_all_languages2.t - Test case to support using Date::Manip.
1.07 2020-02-20 08:30:00
- Updated copyrights to 2020 on all files.
- Made some corrections to the README file.
- Reader.pm - Added an optional trim flag to expand_variables().
- Reader.pm - Fixed balanced quote bug in parse_line().
- Fixed t/60-recursion-test.t & 60-recursion-test.cfg to handle trim
properly.
- 40-validate-modifiers.cfg - Modified to highlight the parse_line()
balanced quote issue was fixed.
- Reader.pm - Fixed disable quotes bug by checking 1st in parse_line()
quote detection section.
- Config.pm - Changed section() to get_section(), depreciating section()
with a stub function that prints warning if used.
- Config.pm - Added create_section() and no longer exposed new_section()
in the POD. Also added new flag SENSITIVE_SECTION to tell if the section
name was sensitive to fix bug in _base_set() & set_value().
- Reader.pm - Fixed to use get_section() & create_section().
- Reader.pm - Fixed hide section bug in read_config().
with variables enabled.
- Added 27-disable_decrypt_test.t to test out this feature.
- Fixed tests t/28-sensitive_tests.t & t/35-improper_tests.t which broke
when we fixed expand_variables().
Never uploaded to CPAN.
1.05 2019-05-30 08:30:00
- Added print_special_vars() as a quick & dirty way to get a list of the
special variables supported by this module.
- Added "section" as a new special variable!
- Added "section" test to t/12-validate_sections.t to validate the new
variable works correctly.
- Options.pm - Added "use_gmt" as a new "Special Date Variable Formatting
Option" to allow the use of gmtime instead of localtime when calculating
the date variable values.
- Options.pm - Fixed bug calculating yesterday/tomorrow when going on/off
daylight savings time during today. Also allowed for leap seconds.
- Config.pm - Removed DBUG code that conflicted with latest release of
the DBUG module (v1.06). So still compatible with earlier releases.
- helper1234.pm - Provided a fix for the DBUG incompatibility issue.
- t/*.t - Fixed all test cases to call the new method in helper1234.pm
to F<new()>. The I<inherit> and I<required> options discussed above are two
such options. In most cases this hash argument isn't needed. So leave it off
if you are happy with the current defaults!
See the POD under L<Advanced::Config::Options>, I<The Get Options> for more
details on what options you may override.
Only the B<L<get_value>> function was truly needed. But the other I<get>
methods were added for a couple of reasons. First to make it clear in your code
what type of value is being returned and provide the ability to do validation of
the B<tag>'s value without having to validate it yourself! Another benifit was
that it drastically reduced the number of exposed I<Get Options> needed for this
module. Making it easier to use.
Finally when these extra methods apply their validation, if the B<tag>'s value
fails the test, it treats it as a I<B<tag> not found> situation as described
above.
=over
=item $value = $cfg->get_value ( $tag[, %override_get_opts] );
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
t/27-disable_decrypt_test.t
t/28-sensitive_tests.t
t/30-alt_symbols_cfg.t
t/35-improper_tests.t
t/40-validate-modifiers.t
t/50-validate-merge.t
t/55-validate-strings.t
t/56-tohash.t
t/60-recursion-test.t
t/70-validate_date_vars.t
t/75-check_all_languages.t
t/76-check_all_languages2.t
t/99-failure.t
t/log_details/abc.log
t/log_summary/abc.log
t/config/10-simple.cfg
t/config/12-use_sections.cfg
t/config/13-alt-get-tests.cfg
t/config/15-multi_source_01_main.cfg
t/config/15-multi_source_02_first.cfg
t/config/30-alt_symbols_01.cfg
t/config/30-alt_symbols_02.cfg
t/config/30-alt_symbols_03.cfg
't/config/30-alt_symbols_04 multi section test.cfg'
't/config/30-alt_symbols_05 space assign.cfg'
't/config/30-alt_symbols_70 merge multiple files.cfg'
t/config/30-alt_symbols_71_empty.cfg
t/config/30-alt_symbols_72_empty.cfg
t/config/30-alt_symbols_80_overlap.cfg
t/config/30-alt_symbols_81_merge_same_file.cfg
t/config/40-validate-modifiers.cfg
t/config/50-merge_a.cfg
t/config/50-merge_b.cfg
t/config/50-merge_c.cfg
t/config/50-merge_d.cfg
t/config/60-recursion-test.cfg
t/config/70-date-validation.cfg
t/config/70-date-validation_2.cfg
t/test-helper/helper1234.pm
META.yml Module meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
lib/Advanced/Config/Date.pm view on Meta::CPAN
# -------------------------------------------------------------
# Proves sometimes the module name is different from the
# real language name.
# -------------------------------------------------------------
# foreach my $k ( sort keys %date_manip_installed_languages ) {
# printf STDERR ("Key (%s) Language (%s)\n", $k, $date_manip_installed_languages{$k}->{Language});
# }
}
# ========================================================================
# Hashes used to help validate/parse dates with ...
# Always keep the keys in lower case.
# Using the values from Date::Language::English for initialization ...
# Hard coded here in case Date::Language wasn't installed ...
# These hashes get rebuilt each time swap_language() is
# successfully called!
# ========================================================================
# Used by parse_date ();
lib/Advanced/Config/Date.pm view on Meta::CPAN
if ( defined $t ) {
($year, $month, $day) = (localtime ($t))[5,4,3];
$year += 1900;
$month += 1;
}
};
}
}
# --------------------------------------------------------------------
# We're done with parsing things. Now let's validate the results!
# --------------------------------------------------------------------
if ( ! defined $year ) {
DBUG_PRINT ("ERROR", "No such date format is supported: %s", $in_date);
# Else we're using a known date format ...
} else {
DBUG_PRINT ("FORMAT", "%s ==> %s ==> (Y:%s, M:%s, D:%s, Sep:%s)",
$fmt, $in_date, $year, $month, $day, $s1);
# It's not a valid date if the separaters are different ...
# Shouldn't be possible any more unless it's spaces.
# (Hence we die if it happens)
if ( $s1 ne $s2 ) {
unless ( $s1 =~ m/^\s*$/ && $s2 =~ m/^\s*$/ ) {
die ("BUG: Separators are different ($s1 vs $s2)\n");
}
}
# Now let's validate the results ...
# Trim leading/trailing spaces ...
$day = $1 if ( $day =~ m/^\s*(.*)\s*$/ );
return DBUG_RETURN ( _check_if_good_date ($in_date, $year, $month, $day) );
}
DBUG_RETURN ( undef ); # Invalid date ...
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
1 <= $part[0] && $part[0] <= 12 &&
1 <= $part[1] && $part[1] <= 31 ) {
( $m, $d, $y ) = ( $part[0], $part[1], $part[2] );
}
if ( $id == 3 && # DDMMYY - European
1 <= $part[1] && $part[1] <= 12 &&
1 <= $part[0] && $part[0] <= 31 ) {
( $m, $d, $y ) = ( $part[1], $part[0], $part[2] );
}
# Now validate the day of month ...
if ( $m > 0 ) {
DBUG_PRINT ("INFO", "Validating if using %s format.", $lbls[$id]);
$y = make_it_a_4_digit_year ( $y );
my $max = $days_in_months[$m];
if ( $m == 2 ) {
my $leap = ($y % 4 == 0) && ($y % 100 != 0 || $y % 400 == 0);
++$max if ( $leap );
}
lib/Advanced/Config/Options.pm view on Meta::CPAN
DBUG_VOID_RETURN ();
}
# ==============================================================
# A private helper method ... (not exported)
sub _get_opt_base
{
DBUG_ENTER_FUNC ( @_ );
my $user_opts = shift;
my $defaults = shift; # Which default hash to validate against ...
# Make own copy of the defaults hash ...
my %result = %{$defaults};
# Must warn about invalid key values ...
foreach ( sort keys %{$user_opts} ) {
my $k = lc ($_);
my $val = $user_opts->{$_};
unless ( exists $defaults->{$k} ) {
t/10-validate_simple_cfg.t view on Meta::CPAN
DBUG_LEAVE (3);
}
# So can tell when the config file was loaded in fish ...
DBUG_PRINT ("====", "%s", "="x50);
print_opts_hash ( "The Read Options", $ropts );
print_opts_hash ( "The Get Options", $gopts );
print_opts_hash ( "The Date Options", $dopts );
# Builds the hash to validate the config file against ...
my ($total, $validate) = init_validation_hash ( $ropts, $dopts );
DBUG_PRINT ("----", "%s", "-"x50);
my @sections = $cfg->find_sections ();
my $cnt = @sections;
dbug_is ($cnt, 1, "The config file doesn't define any sections!");
my @tag_list = $cfg->find_tags ();
$cnt = @tag_list;
dbug_is ($cnt, $total, "Found the expected number of tags in config file ($total)");
DBUG_PRINT ("----", "%s", "-"x50);
$cnt = 0;
foreach ( @tag_list ) {
unless ( exists $validate->{$_} ) {
dbug_ok (0, "Tag \"$_\" exists in the validation hash!");
++$cnt;
}
}
dbug_is ($cnt, 0, "All tags were accounted for in the validation hash!");
DBUG_PRINT ("----", "%s", "-"x50);
foreach ( sort keys %{$validate} ) {
my $val1 = $validate->{$_};
my $val2 = $cfg->get_value ( $_ );
my $val3 = (defined $val2) ? $val2 : "";
my $chk = (defined $val2) && $val1 eq $val2;
dbug_ok ( $chk, "Validating tag \"$_\" matches config file. ($val3)" );
unless ( $chk ) {
DBUG_PRINT ("ERROR", "Value should have been: %s", $val1);
}
}
# Since I didn't count the test cases, must end my program
t/12-validate_sections.t view on Meta::CPAN
DBUG_ENTER_FUNC (@ARGV);
dbug_ok (1, "In the MAIN program ..."); # Test # 2 ...
my $cfg1 = init_object (); # Normal mode ...
DBUG_PRINT ("====", "%s", "="x50);
my $cfg2 = init_object (1); # Inherit mode ...
DBUG_PRINT ("====", "%s", "="x50);
# Builds the hash to validate the config file against ...
my ($valid_normal_cfg, $valid_inherit_cfg) = init_validation_hashes ();
foreach my $idx ( 1, 2 ) {
dbug_ok (1, "-"x40);
my ($cfg, $valid, $mode);
if ( $idx == 1 ) {
($cfg, $valid, $mode ) = ( $cfg1, $valid_normal_cfg, "normal" );
} elsif ( $idx == 2 ) {
t/12-validate_sections.t view on Meta::CPAN
foreach $s ( @sections ) {
dbug_ok ( exists $valid->{$s}, "Found section '$s' in the validaton hash!" );
}
foreach $s ( sort keys %{$valid} ) {
my $sect = $cfg->get_section ($s);
unless ( $sect ) {
dbug_ok (0, "Found section '$s' in the config file!");
next;
}
# Now let's validate the section contents ...
my @tag_list = $sect->find_tags ();
my $cnt1 = @tag_list;
my $cnt2 = keys %{$valid->{$s}};
dbug_is ($cnt1, $cnt2, "Section '$s' has the correct number of tag/value pairs! ($cnt1)");
# Validating the list of tags in the config file match what's in my validation hash.
$cnt = 0;
foreach my $t ( @tag_list ) {
unless ( exists $valid->{$s}->{$t} ) {
dbug_ok (0, "Tag \"$_\" also exists in the validation hash!");
t/13-alt-get-tests.t view on Meta::CPAN
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;
my $fish;
# This program validates all the various "get" methods.
# When we get to this test file we've already proved that
# the basic "get_value()" works so we're able to do a dynamic
# test instead of a static one here!
# This config file has both 4-digit year dates & 2-digit year dates in it.
# Test Config File: t/config/13-alt-get-tests.cfg
BEGIN {
$fish = turn_fish_on_off_for_advanced_config ();
t/13-alt-get-tests.t view on Meta::CPAN
$tag = "file_list_2";
$lst = $cfg->get_list_filename ($tag, undef, undef, required => 0);
$r = dbug_ok ( (! $lst), "The list of files contains one or more bad entries!" );
$ok = 0 unless ( $r );
DBUG_RETURN ( $ok );
}
# ====================================================================
# Builds the boolean array to validate against!
sub run_boolean_tests
{
DBUG_ENTER_FUNC ( @_ );
my $cfg = shift;
my @list = $cfg->find_tags ("^boolean_");
my @answers;
my ($bools, $sep, $ok, $r) = ("", "", 1, 0);
t/13-alt-get-tests.t view on Meta::CPAN
push ( @answers, 0 );
$lst = $cfg->get_list_boolean ($tag);
$res = join (", ", @answers);
$r = dbug_ok ( compare_arrays ( 0, \@answers, $lst ), "Second boolean array test works out! ($res)");
$ok = 0 unless ( $r );
DBUG_RETURN ( $ok );
}
# ====================================================================
# Builds the date array to validate against!
sub run_date_tests
{
DBUG_ENTER_FUNC ( @_ );
my $cfg = shift;
my @list = $cfg->find_tags ("^date_");
# Allow 2-digit years in the test dates!
my %opt = ( "required" => 0, "date_enable_yy" => 1, "date_format" => 3 );
t/15-validate_multi_source_cfg.t view on Meta::CPAN
dbug_ok (0, "Advanced::Config object has been loaded into memory!");
DBUG_LEAVE (3);
}
# So can tell when the config file was loaded in fish ...
DBUG_PRINT ("====", "%s", "="x50);
print_opts_hash ( "The Read Options", $ropts );
print_opts_hash ( "The Get Options", $gopts );
# Builds the hash to validate the config file against ...
my ($total, $validate) = init_validation_hash ( $ropts );
DBUG_PRINT ("----", "%s", "-"x50);
my @sections = $cfg->find_sections ();
my $cnt = @sections;
dbug_is ($cnt, $total, "The config file defines the correct number of sections! ($cnt)");
my $s;
foreach $s ( @sections ) {
dbug_ok ( exists $validate->{$s}, "Found section '$s' in the validaton hash!" );
}
foreach $s ( sort keys %{$validate} ) {
my $sect = $cfg->get_section ($s);
dbug_ok (1, "-"x30);
unless ( $sect ) {
dbug_ok (0, "Found section '$s' in the config file!");
next;
}
my @tag_list = $sect->find_tags ();
my $cnt1 = @tag_list;
my $cnt2 = keys %{$validate->{$s}};
dbug_is ($cnt1, $cnt2, "Section '$s' has the correct number of tag/value pairs! ($cnt1)");
# Validating the list of tags in the config file match what's in my validation hash.
$cnt = 0;
foreach my $t ( @tag_list ) {
unless ( exists $validate->{$s}->{$t} ) {
dbug_ok (0, "Tag \"$_\" exists in the validation hash!");
++$cnt;
}
}
dbug_is ($cnt, 0, "All tags were accounted for in the validation hash for section '$s'!");
# Validating that my hash matches what's in the config file ...
foreach my $t ( sort keys %{$validate->{$s}} ) {
my $val1 = $validate->{$s}->{$t};
my $val2 = $sect->get_value ( $t );
my $chk = (defined $val2) && ($val1 eq $val2);
$val2 = (defined $val2) ? $val2 : "";
dbug_ok ( $chk, "Validating tag \"$t\" in section \"$s\" matches config file. ($val2)" );
unless ( $chk ) {
DBUG_PRINT ("ERROR", "Value should have been: %s", $val1);
}
}
}
t/28-sensitive_tests.t view on Meta::CPAN
#!/usr/bin/perl
# -----------------------------------------------------
# This test case checks if this module thinks the
# specified tags are sensitive or not.
# Sensitive values are not written to fish.
# It doesn't validate any tag's value!
# It tests out all the chk_if_*() functions!
# -----------------------------------------------------
use strict;
use warnings;
use Test::More;
use File::Basename;
use File::Spec;
t/30-alt_symbols_cfg.t view on Meta::CPAN
$ropts = print_opts_hash ( "Read Options for: $f", $ropts );
$dopts = print_opts_hash ( "Date Options for: $f", $dopts );
DBUG_RETURN ( $ropts, $dopts );
}
# ====================================================================
sub compare_config_files
{
DBUG_ENTER_FUNC (@_);
my $src_cfg = shift; # The original validated config file to compare against.
my $dst_cfg = shift; # The new config file to validate.
my $cmts = shift; # The tags with comment chars in their values!
my $sect = shift; # The section to change to.
my ( $cnt1, $cnt2 );
my @sections = $dst_cfg->find_sections ();
$cnt1 = @sections;
dbug_cmp_ok ($cnt1, '>', 0, "The config file has ${cnt1} section(s)!");
if ( $sect ) {
t/40-validate-modifiers.t view on Meta::CPAN
use File::Basename;
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;
# This test case validates that all variable modifiers work as expected.
# These modifiers only work if the left/right anchors are different.
# So using the default variable anchors in this test case.
# See: http://wiki.bash-hackers.org/syntax/pe
# for more details on what these variables modifiers are and how they should
# work.
# This test progam provides hard coded expected answers for each tag defined
# in "40-validate-modifiers.cfg".
my $fish;
BEGIN {
$fish = turn_fish_on_off_for_advanced_config ();
unlink ( $fish );
DBUG_ENTER_FUNC ();
t/40-validate-modifiers.t view on Meta::CPAN
$ENV{yuck} = 1;
$ENV{Yams} = 1;
dbug_ok (1, "In the MAIN program ..."); # Test # 2 ...
my $ropts = Advanced::Config::Options::get_read_opts ( { Croak => 1, dbug_test_use_case_parse_override => 1} );
my $gopts = Advanced::Config::Options::get_get_opts ( { } );
# print_opts_hash ( "The Read Options", $ropts );
# print_opts_hash ( "The Get Options", $gopts );
my $file = File::Spec->catfile ("t", "config", "40-validate-modifiers.cfg");
my $cfg;
eval {
$cfg = Advanced::Config->new ($file, $ropts, $gopts);
dbug_isa_ok ($cfg, 'Advanced::Config');
my $ldr = $cfg->load_config ();
dbug_ok (defined $ldr, "Advanced::Config contents have been loaded into memory!");
};
if ( $@ ) {
unless (defined $cfg) {
dbug_isa_ok ($cfg, 'Advanced::Config');
t/40-validate-modifiers.t view on Meta::CPAN
dbug_ok (0, "Advanced::Config contents have been loaded into memory!");
DBUG_LEAVE (3);
}
# So can tell when the config file was loaded in fish ...
DBUG_PRINT ("====", "%s", "="x50);
print_opts_hash ( "The Read Options", $ropts );
print_opts_hash ( "The Get Options", $gopts );
# Builds the hash to validate the config file against ...
my ($total, $validate) = init_validation_hash ();
my $val = $cfg->get_value ( "msg" );
dbug_cmp_ok ( $val, 'eq', $validate->{msg}, "The test phrases are the same!");
DBUG_PRINT ("----", "%s", "-"x50);
my @sections = $cfg->find_sections ();
my $cnt = @sections;
dbug_is ($cnt, 1, "The config file doesn't define any sections!");
my @tag_list = $cfg->find_tags ();
$cnt = @tag_list;
dbug_is ($cnt, $total, "Found the expected number of tags in config file ($total)");
DBUG_PRINT ("----", "%s", "-"x50);
$cnt = 0;
foreach ( @tag_list ) {
unless ( exists $validate->{$_} ) {
dbug_ok (0, "Tag \"$_\" exists in the validation hash!");
++$cnt;
}
}
dbug_is ($cnt, 0, "All tags were accounted for in the validation hash!");
dbug_ok (1, "-"x60);
foreach ( sort keys %{$validate} ) {
my $val1 = $validate->{$_};
my $val2 = $cfg->get_value ( $_ );
my $val3 = (defined $val2) ? $val2 : "";
my $chk = (defined $val2) && $val1 eq $val2;
dbug_ok ( $chk, "Validating tag \"$_\" matches config file. ($val3)" );
unless ( $chk ) {
DBUG_PRINT ("ERROR", "Value should have been: %s", $val1);
}
}
# Since I didn't count the test cases, must end my program
# with a call to this method. Can't do tests in END anymore!
done_testing ();
DBUG_LEAVE (0);
}
# ====================================================================
# All tags defined in the config file must be initialized below!
# The config file is: t/config/40-validate-modifiers.cfg
# NOTE: No tag may have undef as a value!
# That can't happen in this module if a tag is defined!
# Undef means the tag doesn't exist instead!
sub init_validation_hash
{
DBUG_ENTER_FUNC (@_);
my $Msg = "Be liberal in what you accept, and conservative in what you send.";
t/70-validate_date_vars.t view on Meta::CPAN
$alt_date = \%date2;
# Did we change the date format for the "1_" variables?
if ( exists $ropts->{source_cb} && $ropts->{source_cb} == $my_cb ) {
DBUG_PRINT ("SPECIAL", "Custom callback detected. Using new date formats ...");
my $dop = Advanced::Config::Options::get_date_opts ();
$res = Advanced::Config::Options::set_special_date_vars ( $dop, \%dates);
}
}
# Builds the hash to validate the config file against ...
my ($total, $validate) = init_validation_hash ( \%dates, $alt_date );
my_validation ( $cfg, $total, $validate );
# These 2 tag's values must match if proper config file.
if ( $extra_tests ) {
my $tst = ( $cfg->get_value ("1_timestamp") eq $cfg->get_value ("2_timestamp") );
dbug_ok ($tst, "Both the 1_timestamp & 2_timestamp tags have the same value!");
}
}
# Since I didn't count the test cases, must end my program
# with a call to this method. Can't do tests in END anymore!
t/70-validate_date_vars.t view on Meta::CPAN
# dbug_ok (1, "Sleeping for 4 seconds!");
# sleep (4);
DBUG_RETURN ( undef, $dop );
}
# ====================================================================
sub my_validation
{
DBUG_ENTER_FUNC (@_);
my $cfg = shift; # The config file to validate ...
my $total = shift; # The number of keys in $validate.
my $validate = shift; # The hash to validate against ...
my @sections = $cfg->find_sections ();
my $cnt = @sections;
dbug_is ($cnt, 1, "The config file doesn't define any sections!");
my @tag_list = $cfg->find_tags ();
$cnt = @tag_list;
dbug_is ($cnt, $total, "Found the expected number of tags in config file ($total)");
DBUG_PRINT ("----", "%s", "-"x50);
$cnt = 0;
foreach ( @tag_list ) {
unless ( exists $validate->{$_} ) {
dbug_ok (0, "Tag \"$_\" exists in the validation hash!");
++$cnt;
}
}
dbug_is ($cnt, 0, "All tags were accounted for in the validation hash!");
DBUG_PRINT ("----", "%s", "-"x50);
foreach ( sort keys %{$validate} ) {
my $val1 = $validate->{$_};
my $val2 = $cfg->get_value ( $_ );
my $val3 = (defined $val2) ? $val2 : "";
my $chk = (defined $val2) && $val1 eq $val2;
# If we're unlucky, the timestamps can be dozens of seconds off ...
my $ts = ( $_ =~ m/^[12]_timestamp$/ ) ? 1 : 0;
# if ($ts) { sleep(1); }
if ( $ts && $val2 && ! $chk ) {
my $diff = $val1 - $val3;
t/75-check_all_languages.t view on Meta::CPAN
BEGIN { push (@INC, File::Spec->catdir (".", "t", "test-helper")); }
use helper1234;
# ---------------------------------------------------------------------
# Automatically creates a config file with all Date::Languages in use.
# It doesn't use the tools Advanced::Config has to give me more
# direct control on how the config file is created. Also when originally
# created those tools hadn't been created yet.
# ---------------------------------------------------------------------
# After the config file has been created it attempts to use the
# Config object to validate everything works.
# ---------------------------------------------------------------------
my $fish;
my $config_file_normal;
my $config_file_wide;
my @global_languages;
my @global_lang_use_utf8;
my $run_as_developer = 0;
BEGIN {
t/75-check_all_languages.t view on Meta::CPAN
$status = $cfg1->decrypt_config_file ();
dbug_is ( $status, 1, "The normal decryption status was ${status}" );
$status = $cfg2->decrypt_config_file ();
dbug_is ( $status, 1, "The UTF-8 decryption status was ${status}" );
my $cfg5 = build_new_object ( 0, "Decrypted", 1, $config_file_normal );
my $cfg6 = build_new_object ( 1, "Decrypted", 1, $config_file_wide );
dbug_ok (1, "----------------- Regular ---------------------------------");
validate_MoY_MoYs ( $cfg1 );
validate_dates ( $cfg1, 0 );
dbug_ok (1, "----------------- UTF-8 -----------------------------------");
validate_MoY_MoYs ( $cfg2 );
validate_dates ( $cfg2, 1 );
dbug_ok (1, "----------------- Regular Encrypted -----------------------");
dbug_ok ( compare_objects ( $cfg1, $cfg3 ),
"Both normal objects are the same!" );
dbug_ok (1, "----------------- UTF-8 Encrypted -------------------------");
dbug_ok ( compare_objects ( $cfg2, $cfg4 ),
"Both UTF-8 objects are the same!" );
dbug_ok (1, "----------------- Regular Decrypted -----------------------");
dbug_ok ( compare_objects ( $cfg1, $cfg5 ),
t/75-check_all_languages.t view on Meta::CPAN
++$good;
} else {
++$bad
}
return ( $bad );
}
# --------------------------------------------------------------------
# Validates that reading/writing to the config file doesn't introduce issues.
sub validate_MoY_MoYs
{
DBUG_ENTER_FUNC (@_);
my $cfg = shift;
my $fatal = 0;
DBUG_PAUSE () unless ( $run_as_developer );
foreach ( $cfg->find_sections () ) {
my $sCfg = $cfg->get_section ( $_, 1 );
t/75-check_all_languages.t view on Meta::CPAN
if ($fatal) {
done_testing ();
DBUG_LEAVE (11);
}
DBUG_VOID_RETURN ();
}
# --------------------------------------------------------------------
sub validate_dates
{
DBUG_ENTER_FUNC (@_);
my $cfg = shift;
my $utf8_expected = shift;
DBUG_PAUSE () unless ( $run_as_developer );
foreach my $s ( $cfg->find_sections () ) {
my $sCfg = $cfg->get_section ( $s, 1 );
my $lang = $sCfg->get_value ("Language", {required => 0});
t/75-check_all_languages.t view on Meta::CPAN
print CONFIG "\n";
foreach ( 1..12 ) {
my $dt = sprintf ("%04d-%02d-%02d", 1999, $_, $_ + 15);
print CONFIG " ${dt} = \${$lang.$dt} # ENCRYPT\n";
}
print CONFIG "\n";
}
print CONFIG "----------------------------------------------------------\n\n";
# So can validate we have no issues writing foreign languages to a
# file and reading them back out again!
foreach my $lang ( sort keys %{$all_languages} ) {
my $l = $all_languages->{$lang};
next if ( $l->{wide} && ! $wide_flag );
print CONFIG "[ $lang ]\n";
foreach ( 0..11 ) {
print CONFIG "MoY_${_} = $l->{MoY}->[$_] # ENCRYPT\n";
}
t/76-check_all_languages2.t view on Meta::CPAN
BEGIN { push (@INC, File::Spec->catdir (".", "t", "test-helper")); }
use helper1234;
# ---------------------------------------------------------------------
# Automatically creates a config file with all Date::Manip::Lang::*.pm in use.
# It doesn't use the tools Advanced::Config has to give me more
# direct control on how the config file is created. Also when originally
# created those tools hadn't been created yet.
# ---------------------------------------------------------------------
# After the config file has been created it attempts to use the
# Config object to validate everything works.
# ---------------------------------------------------------------------
my $fish;
my $config_file_normal;
my $config_file_wide;
my @global_modules;
my $run_as_developer = 0;
BEGIN {
# The config file this program is to create!
t/76-check_all_languages2.t view on Meta::CPAN
$status = $cfg1->decrypt_config_file ();
dbug_is ( $status, 1, "The normal decryption status was ${status}" );
$status = $cfg2->decrypt_config_file ();
dbug_is ( $status, 1, "The UTF-8 decryption status was ${status}" );
my $cfg5 = build_new_object ( 0, "Decrypted", 1, $config_file_normal );
my $cfg6 = build_new_object ( 1, "Decrypted", 1, $config_file_wide );
dbug_ok (1, "----------------- Regular ---------------------------------");
validate_MoY_MoYs ( $cfg1, $language_data );
validate_dates ( $cfg1, 0 );
dbug_ok (1, "----------------- UTF-8 -----------------------------------");
validate_MoY_MoYs ( $cfg2, $language_data );
validate_dates ( $cfg2, 1 );
dbug_ok (1, "----------------- Regular Encrypted -----------------------");
dbug_ok ( compare_objects ( $cfg1, $cfg3 ),
"Both normal objects are the same!" );
dbug_ok (1, "----------------- UTF-8 Encrypted -------------------------");
dbug_ok ( compare_objects ( $cfg2, $cfg4 ),
"Both UTF-8 objects are the same!" );
dbug_ok (1, "----------------- Regular Decrypted -----------------------");
dbug_ok ( compare_objects ( $cfg1, $cfg5 ),
t/76-check_all_languages2.t view on Meta::CPAN
} else {
++$bad
}
# DBUG_RETURN ( $bad );
return ( $bad );
}
# --------------------------------------------------------------------
# Validates that reading/writing to the config file doesn't introduce issues.
sub validate_MoY_MoYs
{
DBUG_ENTER_FUNC (@_);
my $cfg = shift;
my $lData = shift;
my $fatal = 0;
DBUG_PAUSE () unless ( $run_as_developer );
foreach ( $cfg->find_sections () ) {
my $sCfg = $cfg->get_section ( $_, 1 );
my $lang = $sCfg->get_value ("Language", {required => 0});
unless ( defined $lang ) {
dbug_ok (1, "Skipping section '${_}' due to no Language tag!");
next;
}
unless ( exists $lData->{$lang} ) {
dbug_ok (0, "No such language ${lang} to validate against!");
next;
}
my (%data, $MoY_ref, $MoYs_ref);
$data{Language} = $lang;
$data{Module} = $lData->{$lang}->{module};
( $MoY_ref, $MoYs_ref ) =
( Advanced::Config::Date::_swap_manip_language_common ( \%data, 0, 1 ) )[3,4];
foreach my $tag ( $sCfg->find_tags (qr /^MoY_/, 0) ) {
t/76-check_all_languages2.t view on Meta::CPAN
if ($fatal) {
done_testing ();
DBUG_LEAVE (11);
}
DBUG_VOID_RETURN ();
}
# --------------------------------------------------------------------
sub validate_dates
{
DBUG_ENTER_FUNC (@_);
my $cfg = shift;
my $utf8_expected = shift;
DBUG_PAUSE () unless ( $run_as_developer );
foreach my $s ( $cfg->find_sections () ) {
my $sCfg = $cfg->get_section ( $s, 1 );
my $lang = $sCfg->get_value ("Language", {required => 0});
t/76-check_all_languages2.t view on Meta::CPAN
print CONFIG "\n";
foreach ( 1..12 ) {
my $dt = sprintf ("%04d-%02d-%02d", 1999, $_, $_ + 15);
print CONFIG " ${dt} = \${$lang.$dt} # ENCRYPT\n";
}
print CONFIG "\n";
}
print CONFIG "----------------------------------------------------------\n\n";
# So can validate we have no issues writing foreign languages to a
# file and reading them back out again!
foreach my $lang ( sort keys %{$all_languages} ) {
my $l = $all_languages->{$lang};
next if ( $l->{wide} && ! $wide_flag );
print CONFIG "[ $lang ]\n";
foreach ( 0..11 ) {
print CONFIG "MoY_${_} = $l->{MoY}->[$_] # ENCRYPT\n";
}
t/76-check_all_languages2.t view on Meta::CPAN
my $Language = eval "\$${module}::LangName"; # The proper name of this language.
my $langData = eval "\$${module}::Language"; # A hash reference with the data!
my %months;
my %days;
my %wdays;
# ------------------------------------------------------
# Used to validate the config files ...
# ------------------------------------------------------
my ($mon_spaces, $day_spaces, $wday_spaces) = (0, 0, 0);
foreach my $m (1..12) {
foreach my $name ( @{$langData->{month_name}->[$m-1]} ) {
my ($n, $before, $after, $spaces) = fix_key ($name);
$months{$n} = $m;
++$mon_spaces if ( $spaces );
$lang_wide = $lang_wide || $before;
$lang_utf8 = $lang_utf8 || $after;
}
t/config/10-simple.cfg view on Meta::CPAN
#
# This is just a sample config file that I'm using as a basis.
# It's validated by t/10-validate_simple_cfg.t
#
# Also repeat any changes here in the: 12-alt_symbols_*.cfg
# files. Those files test preserving this functionality
# using alternate operators.
#
# --------------------------------------------------------------
a = "A is for Apple!"
t/config/12-use_sections.cfg view on Meta::CPAN
# ==========================================================================
#
# Test Program : t/12-validate_sections.t
#
# This File : t/config/12-use_sections.cfg
#
# ==========================================================================
#
# This config file is for testing out using sections.
# Both in exclude & inherit modes.
#
# ==========================================================================
t/config/13-alt-get-tests.cfg view on Meta::CPAN
#
# This config file is used for testing the various "get" type functions.
# It's validated by t/13-alt-get-tests.t
#
# Most lists, used a space separated split. But there were other
# separators used!
# -------------------------------------------------------------------------
# This config file uses format: tag_seq_answer = value
# to validate things against instead of hard coding answers in the test
# program.
# -------------------------------------------------------------------------
# ----------------------------------------------------------------------
# Used to test get_value & get_list & get_hash ...
# ----------------------------------------------------------------------
one_value = "Hello"
two_values = "Hello World!"
t/config/15-multi_source_01_main.cfg view on Meta::CPAN
# ==========================================================================
#
# Test Program : t/15-validate_multi_source_cfg.t
#
# This File : t/config/15-multi_source_01_main.cfg
#
# ==========================================================================
#
# This config file is for testing out sourcing in multiple
# files into a single Advanced::Config object.
#
# For this test all sourced in files use the same operators!
#
t/config/21-0-encrypt-decrypt.cfg view on Meta::CPAN
#
# This is just a sample config file that I'm using as a basis.
# It's validated by t/20-validate_encrypt_decrypt.t
#
# NOTE: All "join" tags reference encrypted variables!
# The above program assumes this is true!
#
# NOTE: Make sure the same tag doesn't appear in mupltiple sections.
# This will brake the test program!
#
# --------------------------------------------------------------
a = "A is for Apple!"
t/config/22-0-encrypt-decrypt.cfg view on Meta::CPAN
#
# This is just a sample config file that I'm using as a basis.
# It's validated by t/20-validate_encrypt_decrypt.t
#
# Using :=: as assignment
# and | as quotes
#
# NOTE: All "join" tags reference encrypted variables!
# The above program assumes this is true!
#
# NOTE: Make sure the same tag doesn't appear in mupltiple sections.
# This will brake the test program!
#
t/config/30-alt_symbol_control.cfg view on Meta::CPAN
# Template Config File : t/config/10-simple.cfg
#
# ==========================================================================
# The test program genrerates thousands of test cases via this config file.
# And at this point it should be fairly rare to have to update it to
# support changes made to this config file.
# ==========================================================================
#
# This config file controls which config files are compared to a template to
# see if various combinations of "Read Options" will load and result in an
# equivalant config file. This template has been 100% validated by another
# test case and so it provides a good basis for easy comparisons.
#
# It's an equivalant config file if once loaded the list of tags and their
# values remain the same. If this is true, all the test cases will pass. If
# it isn't true, one or more test cases will fail and I will know that either
# there is an issue with the config file or I've uncovered another bug in my
# module to fix.
#
# In any case, I will only release this module when all test cases pass. Only
# during development when I add a new test config file should any test cases
t/config/30-alt_symbol_control.cfg view on Meta::CPAN
# 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
# config file with sections, it only compares the current section in
# the target config file. All other sections will be ignored.
#
# If you don't use one of the special tags, it will only compare against
# the default main section.
#
t/config/30-alt_symbols_01.cfg view on Meta::CPAN
:
: This is just a sample config file that I'm using as a basis.
: It's validated by t/30-alt_symbols_cfg.t
:
: Any changes made to this config file should also be refleced
: in: t/config/10-simple.cfg
: That config file is used to validate this one!
:
: --------------------------------------------------------------
: The required substitutions ...
: Assignment (=) ==> ==
: Comments (#) ==> :
: Variables (${..}) ==> $[..]
: Quotes (' or ") ==> ^..^
: --------------------------------------------------------------
t/config/30-alt_symbols_02.cfg view on Meta::CPAN
=
= This is just a sample config file that I'm using as a basis.
= It's validated by t/30-alt_symbols_cfg.t
=
= Any changes made to this config file should also be refleced
= in: t/config/10-simple.cfg
= That config file is used to validate this one!
=
= --------------------------------------------------------------
= The required substitutions ...
= Assignment (=) ==> ==
= Comments (#) ==> =
= Variables (${..}) ==> %..%
= Quotes (' or ") ==> <..>
= --------------------------------------------------------------
t/config/30-alt_symbols_03.cfg view on Meta::CPAN
?
? This is just a sample config file that I'm using as a basis.
? It's validated by t/30-alt_symbols_cfg.t
?
? Any changes made to this config file should also be refleced
? in: t/config/10-simple.cfg
? That config file is used to validate this one!
?
? --------------------------------------------------------------
? The required substitutions ...
? Assignment (=) ==> :=
? Comments (#) ==> ?
? Variables (${..}) ==> $[..]
? Quotes (' or ") ==> @..@
? --------------------------------------------------------------
section_03 := This is a long section name!
t/config/30-alt_symbols_04 multi section test.cfg view on Meta::CPAN
CMT:
CMT: This is just a sample config file that I'm using as a basis.
CMT: It's validated by t/30-alt_symbols_cfg.t
CMT:
CMT: Any changes made to this config file should also be refleced
CMT: in: t/config/10-simple.cfg
CMT: That config file is used to validate this one!
CMT:
CMT: --------------------------------------------------------------
CMT: The required substitutions ...
CMT: Assignment (=) ==> ~
CMT: Comments (#) ==> CMT:
CMT: Variables (${..}) ==> $<..>
CMT: Quotes (' or ") ==> '..'
CMT: Section ([..]) ==> {..}
CMT: --------------------------------------------------------------
t/config/30-alt_symbols_05 space assign.cfg view on Meta::CPAN
:
: This is just a sample config file that I'm using as a basis.
: It's validated by t/30-alt_symbols_cfg.t
:
: Any changes made to this config file should also be refleced
: in: t/config/10-simple.cfg
: That config file is used to validate this one!
:
: --------------------------------------------------------------
: The required substitutions ...
: Assignment (=) ==> \\s
: Comments (#) ==> :
: Variables (${..}) ==> $[..]
: Quotes (' or ") ==> ^..^
: --------------------------------------------------------------
: This one's very ugly with no assignment operator being used!
: --------------------------------------------------------------
t/config/40-validate-modifiers.cfg view on Meta::CPAN
#
# This is a sample test file I'm using to validate the variable modifiers!
# It's used by t/40-validate-modifiers.t
#
# Every time you modify this config file, you must update the test script as
# well! That script must reference everything defined in this file and
# vice versa!
#
msg = Be liberal in what you accept, and conservative in what you send.
# Tests out the Substring removal options ....
t/config/50-merge_a.cfg view on Meta::CPAN
#
# This is a sample test file I'm using to validate the variable modifiers!
# It's used by t/50-validate-merge.t
#
# Every time you modify this config file, you must update the test script as
# well! That script must reference everything defined in this file and
# vice versa!
#
a_main_lbl = "Hello World"
[ section A ]
t/config/50-merge_b.cfg view on Meta::CPAN
#
# This is a sample test file I'm using to validate the variable modifiers!
# It's used by t/config/50-merge_a.cfg
#
# Every time you modify this config file, you must update the test script as
# well! That script must reference everything defined in this file and
# vice versa!
#
b_main_lbl = "Hello World"
[ section B ]
( run in 0.420 second using v1.01-cache-2.11-cpan-4d50c553e7e )