Advanced-Config
view release on metacpan or search on metacpan
t/13-alt-get-tests.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
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;
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 ();
unlink ( $fish );
DBUG_ENTER_FUNC ();
use_ok ("Advanced::Config");
DBUG_VOID_RETURN ();
}
END {
DBUG_ENTER_FUNC ();
# Don't do any tests in the END block ...
DBUG_VOID_RETURN ();
}
# --------------------------------------
# Global Variables
# --------------------------------------
my $all_ok; # Tells if any get_list_values() tests failed or not.
# --------------------------------------
# Start of the main program!
# --------------------------------------
{
# Turn fish on ...
DBUG_PUSH ( $fish );
DBUG_ENTER_FUNC (@ARGV);
dbug_ok (1, "In the MAIN program ..."); # Test # 2 ...
my $file = File::Spec->catfile ("t", "config", "13-alt-get-tests.cfg");
my $cfg;
eval {
my %gOpt = ( "required" => 2 );
$cfg = Advanced::Config->new ($file, undef, \%gOpt);
dbug_isa_ok ($cfg, 'Advanced::Config');
my $ldr = $cfg->load_config ();
dbug_ok (defined $ldr, "Advanced::Config object has been loaded into memory!");
};
if ( $@ ) {
unless (defined $cfg) {
dbug_ok (defined $cfg, "Advanced::Config object has been created!");
}
dbug_ok (0, "Advanced::Config object has been loaded into memory!");
DBUG_LEAVE (3);
}
# So can tell when the config file finished loading in fish ...
t/13-alt-get-tests.t view on Meta::CPAN
{
DBUG_ENTER_FUNC ( @_ );
my $cfg = shift;
my ($file, $d, $bad, $ok, $r, $tag);
# The individual file tests ...
$file = $cfg->get_filename ("file_1");
$r = dbug_ok ( $file, "Found file: ${file}");
$ok = $r;
$file = $cfg->get_filename ("file_2");
$r = dbug_ok ( $file, "Found file: ${file}");
$ok = 0 unless ( $r );
$tag = "file_bad_2";
$file = $cfg->get_filename ($tag, undef, required => 0);
$bad = $cfg->get_value ($tag);
$d = $cfg->get_directory ($tag);
$r = dbug_ok ( ($d && ! $file), "It's a directory, not a file: ${bad}");
$ok = 0 unless ( $r );
# ---------------------------------------------------------
# No-such file, create file, no-such file tests ...
# ---------------------------------------------------------
$tag = "file_bad_1";
$file = $cfg->get_filename ($tag, undef, required => 0);
$bad = $cfg->get_value ($tag);
$d = $cfg->get_directory ($tag, undef, required => 0);
$r = dbug_ok ( (! $file && ! $d), "No such file or directory: ${bad}");
$ok = 0 unless ( $r );
open (FILE, ">", $bad) or die ("Can't create file: $bad\n");
close (FILE);
$file = $cfg->get_filename ($tag);
$r = dbug_ok ( ($file && ! $d), "The file now exists! ${bad}");
$ok = 0 unless ( $r );
unlink ( $bad );
$file = $cfg->get_filename ($tag, undef, required => 0);
$r = dbug_ok ( (! $file && ! $d), "No such file or directory again: ${bad}");
$ok = 0 unless ( $r );
# ---------------------------------------------------------
# The list tests ...
$tag = "file_list_1";
my $ref = $cfg->get_list_values ($tag);
my $lst = $cfg->get_list_filename ($tag);
$r = dbug_ok ( compare_arrays ( 0, $ref, $lst ), "The file list arrays are the same!" );
$ok = 0 unless ( $r );
$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);
foreach my $tag (@list) {
my $prediction = 0; # False
if ( $tag =~ m/_([^_]+)$/ ) {
$prediction = $1; # 1 or 0 (True/False)
}
my $other = $cfg->get_value ( $tag );
my $ans = $cfg->get_boolean ( $tag );
$r = dbug_cmp_ok ($ans, '==', $prediction, "Tag ${tag} correctly evaluated '${other}' to ${prediction}");
$ok = 0 unless ( $r );
# Save the test results. (except the problem one!)
if ( $other ne "" ) {
push ( @answers, $prediction );
$bools .= ${sep} . $other;
$sep = " ";
}
}
# Build a list of boolean values we can split and evaluate ...
my $tag = "test_bool_list";
$cfg->set_value ( $tag, $bools );
my $lst = $cfg->get_list_boolean ($tag);
my $res = join (", ", @answers);
$r = dbug_ok ( compare_arrays ( 0, \@answers, $lst ), "The boolean arrays are the same! ($res)" );
$ok = 0 unless ( $r );
# Add a junk value to end of boolean list ...
$cfg->set_value ( $tag, $bools . " An-unknown-value-is-false" );
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 );
}
# ====================================================================
# Assumes run_date_tests() passes it's get_test() tests.
# Also assumes the extensive tests in t/09-basic_date.t passes.
# So it's OK to perform minimal testing here!
sub run_alt_date_tests
{
DBUG_ENTER_FUNC ( @_ );
my $cfg = Advanced::Config->new (undef, undef, { "required" => 0, "date_language" => "English" }, undef );
$cfg->set_value ("2024-01-01", "Jan 1, 1900");
$cfg->set_value ("2024-01-02", "not date");
t/13-alt-get-tests.t view on Meta::CPAN
$ans = $cfg->get_hyd_date ($tag);
$sts = dbug_is ($ans, undef, "hyd test for non-date tag $tag");
$ok = 0 unless ($sts);
$ans = $cfg->get_dow_date ($tag);
$sts = dbug_is ($ans, undef, "dow test for non-date tag $tag (n/a)");
$ok = 0 unless ($sts);
$ans = $cfg->get_doy_date ($tag);
$sts = dbug_is ($ans, undef, "doy test for non-date tag $tag");
$ok = 0 unless ($sts);
$ans = $cfg->get_adjusted_date ($tag, 1, 2);
$sts = dbug_is ($ans, undef, "adjusted test for non-date tag $tag");
$ok = 0 unless ($sts);
}
# The given date doesn't exist as a tag ...
$tag = "1900-01-03";
$ans = $cfg->get_hyd_date ($tag);
$sts = dbug_cmp_ok ($ans, "==", 3, "hyd test for non-tag $tag");
$ok = 0 unless ($sts);
$ans = $cfg->get_dow_date ($tag);
$sts = dbug_cmp_ok ($ans, "==", 3, "dow test for non-tag $tag (Wednsday)");
$ok = 0 unless ($sts);
$ans = $cfg->get_doy_date ($tag);
$sts = dbug_cmp_ok ($ans, "==", 3, "doy test for non-tag $tag");
$ok = 0 unless ($sts);
$ans = $cfg->get_adjusted_date ($tag, 1, 2);
$sts = dbug_cmp_ok ($ans, "eq", "1901-03-03", "adjusted test for non-tag $tag");
$ok = 0 unless ($sts);
# The given hyd doesn't exist as a tag ...
$tag = "3"; # 1900-01-03
$ans = $cfg->get_hyd_date ($tag);
$sts = dbug_is ($ans, undef, "hyd test for HYD $tag");
$ok = 0 unless ($sts);
$ans = $cfg->get_dow_date ($tag);
$sts = dbug_cmp_ok ($ans, "==", 3, "dow test for HYD $tag (Wednsday)");
$ok = 0 unless ($sts);
$ans = $cfg->get_doy_date ($tag);
$sts = dbug_is ($ans, undef, "doy test for HYD $tag");
$ok = 0 unless ($sts);
$ans = $cfg->get_adjusted_date ($tag, 1, 2);
$sts = dbug_cmp_ok ($ans, "eq", "1901-03-03", "adjusted test for HYD $tag");
$ok = 0 unless ($sts);
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 );
my @answers;
my ($dates, $sep, $ok, $r) = ("", "", 1, 0);
foreach my $tag (@list) {
my $prediction;
if ( $tag =~ m/^date_\d+_(\d{4}-\d{2}-\d{2})$/ ) {
$prediction = $1; # The resulting date ...
} elsif ( $tag =~ m/^date_\d+_bad$/ ) {
$prediction = ""; # Invalid Date ...
} else {
die ("Improperly formatted date tag: $tag (<name>_<test-number>_<YYYY-MM-DD>) or (<name>_<test-number>_bad)\n");
}
my $raw = $cfg->get_value ( $tag );
my $ans = $cfg->get_date ( $tag, undef, \%opt );
my $chk;
if ( $prediction ) {
$chk = ($prediction eq $ans);
} else {
$chk = (! defined $ans);
}
$r = dbug_ok ( $chk, "Tag ${tag} correctly evaluated '${raw}' to '${prediction}'");
unless ( $r ) {
$ok = 0;
next;
}
next unless ( $prediction );
push ( @answers, $prediction ); # In YYYY-MM-DD format ...
$dates .= ${sep} . ${raw};
$sep = " | ";
}
# Build a list of date values we can split and evaluate ...
my $tag = "test_date_list";
$cfg->set_value ( $tag, $dates );
my $lst = $cfg->get_list_date ( $tag, qr/\s*[|]\s*/, undef, \%opt );
my $res = join (", ", @answers);
$res = substr ($res, 0, 40) . "...";
$r = dbug_ok ( defined $lst && compare_arrays ( 0, \@answers, $lst ), "The date arrays are the same! ($res)" );
$ok = 0 unless ( $r );
$cfg->set_value ( $tag, $dates . ${sep} . "Bad-Date" );
$lst = $cfg->get_list_date ( $tag, qr/\s*[|]\s*/, undef, \%opt );
$res = $cfg->get_value ( $tag );
$r = dbug_ok ( (! defined $lst), "The date array had a bad date in it! (... | Bad-Date)" );
$ok = 0 unless ( $r );
( run in 0.782 second using v1.01-cache-2.11-cpan-39bf76dae61 )