Advanced-Config
view release on metacpan or search on metacpan
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
fish files. Also speeded up the test cases.
- Fixed POD NAME on all *.pm files to follow Perl standards.
- Corrected various typos in the POD.
- Updated stale links in the POD.
- Config.pm & Options.pm - Added On/Off to get_boolean() & updated the POD
to say so.
- Config.pm - removed depreciated function section().
- Makefile.PL - Fixed build script bug.
- Fixed to require Fred::Fish::DBUG v2.09 so I could use it's new Test module
in the t/*.t test scripts. Simplified a lot of code.
- Updated copyright to 2025 in all files.
1.09 2020-10-05 08:30:00
- Fixed so minimum version of 2.01 required for using Fred::Fish::DBUG.
- Modified all *.pm files to eliminate the BEGIN logic the older versions
of DBUG required.
- Modified all t/*.t test progs to use Fred::Fish::DBUG 2.01 qw / on /;
1.08 2020-03-16 08:30:00
- Config.pm - Fixed most functions not exposed by POD to use a leading
underscore in their names to be more consistent. The remaining exceptions
used to be exposed in POD and are being depreciated. As always anything
beginning with an underscore is subject to change without notice.
- Date.pm - Major rewrite of parse_date() in advance of using Date::Manip as
an alternate source to getting foreign language support.
- Date.pm - Adding Date::Manip logic. Greatly expands the number of languages
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.
all the languages defined by Date::Language & realized just how inconsistent
that module's language files really are. But I don't have a better source
for this data.
- Config.pm - Fixed bug in load_config & load_string where it was modifying
the default options instead of overriding them.
- Added new option use_utf8 to supports config files written in UTF-8 mode.
- Added new option to disable variable modifications when they cause
problems.
- Updated Makefille.PL to make DBUG v1.09 the minimum allowed version.
That's when DBUG supported writing Wide Chars to fish. It also allowed
me to simplify all t/*.t test programs logging by removing support
for obsolete features. The module itself will still work with DBUG
v1.03 or later as long as option 'use_utf8' isn't being used.
- t/00-basic.t - Fixed to enforce the same min version as Makefile.PL.
- helper1234.pm - Removed fixes for earlier DBUG versions. No longer
any need for a lot of conditional logic in test cases.
- t/*.t - Removed calls to helper methods removed from helper1234.pm
as no longer needed after DBUG min version upgraded.
- Created full_developer_test.pl.src to make things easier for a
full test of the module. Does a summary pass then a detailed pass.
- Created t/log_summary & t/log_details log dirs to hold the logs for
each pass. By default "make test" uses t/log_details.
- Modified all t/*.t to call turn_fish_on_off_for_advanced_config()
in the helper package to calculate which log dir to put the log
file into.
- Reader.pm - fixed perl 5.28 bitwise exclusive or on Unicode strings being
depreciated.
1.06 2019-11-01 08:30:00
- Removed the DBUG_REGISTER call from all modules since it's definition
changed in DBUG (v1.08) and was depreciated.
- Added the 3 back quote options for allowing your config files to run
commands to set a tag's value per a user request. (Disabled by default)
- Then removed it for being too much of a security concern. Left the options
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
for when it would hit the incompatibility.
- Forced t/00-basic.t to enforce minimum module versions for "make test".
Never uploaded to CPAN.
1.04 2019-03-13 08:30:00
- Broke circular references that was requiring the same logic in multiple
modules. Now just done in Options.pm and referenced by the other modules.
- Examples.pm - Fixed more typos in the POD.
- 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.
# This begin block initializes the special variables used
# for "rule 5" & "rule 6" in lookup_one_variable()
# and _find_variables()!
BEGIN
{
DBUG_ENTER_FUNC ();
# -----------------------------------------------
# These are the "Rule 5" special perl varibles.
# Done this way to avoid having to support
# indirect "eval" logic.
# -----------------------------------------------
$begin_special_vars{'0'} = ($0 eq "-e") ? "perl" : $0;
$begin_special_vars{'$'} = $$;
$begin_special_vars{'^O'} = $^O; # MSWin32, aix, etc ...
# ---------------------------------------------
# Start of the "rule 6" initialization ...
# ---------------------------------------------
$begin_special_vars{PID} = $$;
$begin_special_vars{user} = Advanced::Config::Options::_get_user_id ();
# Special Date Variables ...
set_special_date_vars ($control{date_opts}, \%dates);
$control{DATES} = \%dates;
$control{DATE_USED} = 0;
# Environment variables referenced ...
$control{ENV} = \%empty;
# Timestamps & options used for each config file loaded into memory ...
# Controls the refesh logic.
$control{REFRESH_MODIFY_TIME} = \%mods;
$control{REFRESH_READ_OPTIONS} = \%ropts;
# Used to detect recursion ...
$control{RECURSION} = \%rec;
# Used to detect recursion ...
$control{MERGE} = \@lst;
# The count for sensitive entries ...
# Loading the original file ...
$self->_wipe_internal_data ( $filename );
}
# Auto add the alias if it's a symbolic link & there isn't an alias.
# Otherwise decryption won't work!
if ( -l $filename && ! $read_opts->{alias} ) {
$read_opts->{alias} = abs_path( $filename );
}
# So refresh logic will work ...
$self->{CONTROL}->{REFRESH_MODIFY_TIME}->{$filename} = (stat( $filename ))[9];
$self->{CONTROL}->{REFRESH_READ_OPTIONS}->{$filename} = get_read_opts ($read_opts);
# So will auto-clear if die is called!
local $self->{CONTROL}->{RECURSION}->{$filename} = 1;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_string";
if ( $c eq $by ) {
# Manually merging in another string as a config file.
push (@{$self->{CONTROL}->{MERGE}}, $filename);
} else {
# Loading the original string ...
$self->_wipe_internal_data ( $filename );
}
# So refresh logic will work ...
$self->{CONTROL}->{REFRESH_MODIFY_TIME}->{$filename} = 0; # No timestamp!
$self->{CONTROL}->{REFRESH_READ_OPTIONS}->{$filename} = get_read_opts ($read_opts);
# So will auto-clear if die is called!
local $self->{CONTROL}->{RECURSION}->{$filename} = 1;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
$hide = 1 if ( should_we_hide_sensitive_data ($tag, 1) );
}
}
# The value must never be undefined!
$self->{DATA}->{$tag}->{VALUE} = (defined $value) ? $value : "";
# What file the tag was found in ...
$self->{DATA}->{$tag}->{FILE} = $file;
# Must it be hidden in the fish logs?
$self->{DATA}->{$tag}->{MASK_IN_FISH} = $hide;
# Is the value still encrypted?
$self->{DATA}->{$tag}->{ENCRYPTED} = $still_encrypted ? 1 : 0;
# Does the value still reference variables?
$self->{DATA}->{$tag}->{VARIABLE} = $has_variables ? 1 : 0;
return ( 1, $hide );
}
the parent object instead.
=cut
sub create_section
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $name = shift;
# This test bypasses all the die logic in the special case constructor!
# That constructor is no longer exposed in the POD.
if ( $self->get_section ( $name ) ) {
return DBUG_RETURN (undef); # Name is already in use ...
}
DBUG_RETURN ( $self->new_section ( $self, $name ) );
}
#######################################
sub export_tag_value_to_ENV
{
my $self = shift;
my $tag = shift;
my $value = shift;
my $hide = $_[0] || 0; # Not taken from stack on purpose ...
DBUG_ENTER_FUNC ( $self, $tag, ($hide ? "*"x8 : $value), @_ );
$ENV{$tag} = $value;
# Check if the change afects the refresh logic ...
my $pcfg = $self->{PARENT} || $self;
if ( exists $pcfg->{CONTROL}->{ENV}->{$tag} ) {
$pcfg->{CONTROL}->{ENV}->{$tag} = $value; # It did ...
}
DBUG_VOID_RETURN ();
}
#######################################
For rule B<6>, the predefined module variables are: ${PID}, ${PPID}, ${user},
${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 ...
# 3. Look in the requested section(s) ...
if ( ! defined $val && $var =~ m/[.]/ ) {
($val, $mask_flag, $encrypt_flag) = $self->rule_3_section_lookup ( $var );
}
# 4. Look in the %ENV hash ...
if ( ! defined $val && defined $ENV{$var} ) {
$val = $ENV{$var};
$mask_flag = should_we_hide_sensitive_data ($var);
# Record so refresh logic will work when %ENV vars change.
$pcfg->{CONTROL}->{ENV}->{$var} = $val;
}
# 5. Look at the special Perl variables ... (now done as part of 6.)
# 6. Is it one of the predefined module variables ...
# Variables should either be all upper case or all lower case!
# But allowing for mixed case.
if ( ! defined $val ) {
if ( exists $begin_special_vars{$var} ) {
$val = $begin_special_vars{$var};
}
}
# 7. Is it one of the special date variables ...
# All these date vars only use lower case!
if ( ! defined $val ) {
my $lc_var = lc ($var);
if ( defined $pcfg->{CONTROL}->{DATES}->{$lc_var} ) {
$val = $pcfg->{CONTROL}->{DATES}->{$lc_var};
# Record so refresh logic will work when the date changes.
# Values:
# 0 - unknown date variable. (so refresh will ignore it.)
# 1 - MM/DD/YYYY referenced. (refresh on date change.)
# 2 - MM or MM/YYYY referenced. (refresh if the month changes.)
# 3 - YYYY referenced. (refresh if the year changes.)
my $rule = 0;
if ( $lc_var =~ m/^((yesterday)|(today)|(tomorrow)|(dow)|(doy)||(dom))$/ ) {
$rule = 1;
} elsif ( $lc_var =~ m/^((last)|(this)|(next))_month$/ ) {
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/15-multi_source_03_second.cfg
t/config/15-multi_source_04_third.cfg
t/config/20-0-encrypt-decrypt.cfg
t/config/21-0-encrypt-decrypt.cfg
t/config/22-0-encrypt-decrypt.cfg
# 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.
INSTALLATION
=====================================================================
# -----------------------------------------------------------------------------
# Reporting a bug in Advanced::Config
# -----------------------------------------------------------------------------
Support is very limited, but I will do my best to help resolve any problems
you have with my module if you provide the following files demonstrating the
bug/issue you are hitting.
1) A sample config file.
2) A sample program that uses the config file and demonstrates the bug.
3) The fish log generated. (optional) But I'll request one if the issue
isn't reproducable on my end with what you gave me.
If it's a true bug, I'll probably use your sample program as the basis for a
new test case in a future release.
See a section below on how to turn on the logs of Fred::Fish::DBUG that
Advanced::Config uses to trace it's functionality to show why the code is
having issues.
# -----------------------------------------------------------------------------
# What if a test case fails?
# -----------------------------------------------------------------------------
In this case there should already be logs to send out. Each and every test
program that comes with this module generates very verbose logging of what's
happening. So just open a CPAN ticket and attach the log to the ticket. Do
not cut and paste the logs contents into the ticket! It just makes the ticket
unreadable.
These logs can be found under t/log_details/*.txt
# -----------------------------------------------------------------------------
# What if it's your program that's failing?
# Then you need to turn on Fred::Fish::DBUG tracing used by Advanced::Config.
# This will generate the log file to attach to the CPAN ticket.
# -----------------------------------------------------------------------------
This module uses Fred::Fish::DBUG for logging the activity of this module.
But this logging is disabled by default, even if you are using Fred::Fish::DBUG
to trace your own code!
So here's a list of steps needed to turn this tracing on.
1) Set this special environment varible to 1. (tells my module to enable fish.)
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.
# -----------------------------------------------------------------------------
# Major features of this module:
# -----------------------------------------------------------------------------
1) Supports simple config files. (Tag/Value pairs with comments.)
2) Supports sourcing in other config files to dynamically create one big
config file to reference as a single object.
3) Supports the use of variables in the config file.
4) Supports the use of sections to better organize your config file's data.
5) Supports inheritance between sections.
full_developer_test.pl.src view on Meta::CPAN
# make does: perl full_developer_test.pl.src full_developer_test.pl
# ------------------------------------------------------------------------
# Running: full_developer_test.pl
# ------------------------------------------------------------------------
# It runs "make test" 2 times with changes to $ENV{FISH_OFF_FLAG}
# 1) FISH_OFF_FLAG = 1 Run tests using Fred::Fish::DBUG qw /OFF/
# 2) FISH_OFF_FLAG = 0 Run tests using Fred::Fish::DBUG qw /ON/
#
# If a "make test" fails, it won't run the next in the series!
#
# There will be fish logs generated in each case. The only difference
# is when FISH_OFF_FLAG is set, Advanced::Config itself won't use fish.
# Only the test programs themselves will use it. Which is how this
# module is expected to be run by normal users.
# It just proves that using Fred::Fish::DBUG "on" vs "off" doesn't change
# the behaviour of my module.
# ------------------------------------------------------------------------
# Running: full_developer_test.pl t/<name>.t
# ------------------------------------------------------------------------
# Forces a "make" first.
# Runs just that one test program 2 times instead of the full "make test".
full_developer_test.pl.src view on Meta::CPAN
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
use File::Spec;
use Cwd 'abs_path';
use File::Basename;
use File::Copy;
use File::Glob qw (bsd_glob);
# The number of fish log files to locate for each 'make test' run!
use constant MAX => 28;
my $fish_dir_summary;
my $fish_dir_details;
BEGIN {
eval {
require Time::HiRes;
Time::HiRes->import ( qw(time sleep) );
};
}
# Main Program ...
{
$fish_dir_summary = File::Spec->catdir ("t", "log_summary");
$fish_dir_details = File::Spec->catdir ("t", "log_details");
unless ( -d "t" ) {
die ("No such sub-dir './t'. Must run from the build dir!\n");
}
unless ( -d $fish_dir_summary ) {
die ("No such sub-dir '${fish_dir_summary}'. Must run from the build dir!\n");
}
unless ( -d $fish_dir_details ) {
die ("No such sub-dir '${fish_dir_details}'. Must run from the build dir!\n");
}
full_developer_test.pl.src view on Meta::CPAN
} elsif ( $fail_test_msg eq "DETAIL" ) {
$fail_detail_flag = 1;
} elsif ( $fail_test_msg eq "SUMMARY" ) {
$fail_summary_flag = 1;
}
if ( $one_test_prog ) {
run_specific_test ( $one_test_prog, $one_fish_base, $fail_summary_flag, $fail_detail_flag );
} else {
delete_old_fish_logs ();
run_all_tests ( $make, $fail_summary_flag, $fail_detail_flag ); # Does via "make test".
}
exit (0);
}
# ==============================================================================
# Start of the functions called ...
# ==============================================================================
full_developer_test.pl.src view on Meta::CPAN
my $summary_flag = shift;
my $details_flag = shift;
my ( $summary_msg, $detail_msg );
my $t0 = time ();
# Run the summary test ...
eval {
local $ENV{FAIL_TEST_99} = 1 if ( $summary_flag );
run_make_test ( $make, 1, MAX, "=", "Fred::Fish::DBUG::OFF, just high level logs generated. (fast)" );
};
if ( $@ ) {
$summary_msg = $@;
}
my $t1 = time ();
# Run the detailed test ...
eval {
local $ENV{FAIL_TEST_99} = 1 if ( $details_flag );
run_make_test ( $make, 0, MAX, "-", "Fred::Fish::DBUG::ON, providing detailed logging. (slow)" );
};
if ( $@ ) {
$detail_msg = $@;
}
my $t2 = time ();
print_status ( $summary_msg, $detail_msg );
printf "Pass 1: %.1f second(s)\n", ($t1 - $t0);
printf "Pass 2: %.1f second(s)\n", ($t2 - $t1);
full_developer_test.pl.src view on Meta::CPAN
}
# Run a test suite in the requested mode ...
sub run_make_test
{
my $make = shift; # Which make command to use.
my $off_flag = shift; # Which setting to use: 0, 1.
my $num_fish = shift; # The number of fish files to expect ...
my $sep_char = shift;
my $log_msg = shift;
my $mk = basename ($make);
printf ("\n%s\n", ${sep_char}x50);
print "Running '${mk} test' for ${log_msg} ...\n";
printf ("%s\n\n", ${sep_char}x50);
# Determine the test mode to use ...
$ENV{FISH_OFF_FLAG} = ${off_flag};
# Run the tests ...
my $res = system ("${make} test");
my $cnt = show_fish_logs ( ${off_flag} ? $fish_dir_summary : $fish_dir_details );
# Check out the results ...
if ( $res != 0 ) {
die ("Failed one or more test cases! FISH_OFF_FLAG == ${off_flag} (${log_msg}!)\n\n");
}
if ( $cnt != ${num_fish} ) {
die ("Failed final test case! FISH_OFF_FLAG == ${off_flag} (${log_msg}!)\n",
"Wrong number of fish logs generated! (${cnt} vs ${num_fish})\n\n");
}
return;
}
# Run a single test in both modes using "prove" ...
sub run_specific_test
{
my $prog = shift;
my $fish = shift; # The basename of the fish log file ...
my $summary_flag = shift;
my $details_flag = shift;
my $log_s = File::Spec->catfile ($fish_dir_summary, $fish);
my $log_d = File::Spec->catfile ($fish_dir_details, $fish);
# Delte both log files ...
unlink ( $log_s, $log_d );
my ( $summary_msg, $detail_msg );
my $prove = which_prove ( $prog );
# Run the summary test ...
eval {
local $ENV{FAIL_TEST_99} = 1 if ( $summary_flag );
run_that_test ( $prove, $prog, $log_s, 1, "=", "Fred::Fish::DBUG::OFF, just high level logs available. (fast)" );
};
if ( $@ ) {
$summary_msg = $@;
}
# Run the detailed test ...
eval {
local $ENV{FAIL_TEST_99} = 1 if ( $details_flag );
run_that_test ( $prove, $prog, $log_d, 0, "-", "Fred::Fish::DBUG, providing detailed logging. (slow)" );
};
if ( $@ ) {
$detail_msg = $@;
}
print_status ( $summary_msg, $detail_msg );
return;
}
sub run_that_test
{
my $prove = shift; # Prove or Perl binary to use.
my $prog = shift;
my $fish = shift;
my $off_flag = shift; # Which setting to use: 0, 1.
my $sep_char = shift;
my $log_msg = shift;
my $p = basename ($prove);
# Determine the test mode to use ...
$ENV{FISH_OFF_FLAG} = ${off_flag};
# Running the test via prove ...
printf ("\n%s\n", ${sep_char}x50);
print "Running '${p} -bv ${prog}' for ${log_msg} ...\n";
printf ("%s\n\n", ${sep_char}x50);
my $res = system ("${prove} -bv ${prog}");
if ( $res != 0 ) {
die ("Failed test case ($res)! FISH_OFF_FLAG == ${off_flag} (${log_msg}!)\n\n");
}
if ( -f $fish ) {
print "Found fish file: ${fish}\n";
} else {
print "No fish file found: ${fish}\n";
}
return;
}
full_developer_test.pl.src view on Meta::CPAN
} else {
print "\nAll tests ran OK!\n\n";
}
return;
}
# Lists the fish files generated by "make test" ...
sub show_fish_logs
{
my $fish_dir = shift;
print "\nThe fish logs for: FISH_OFF_FLAG == $ENV{FISH_OFF_FLAG} ...\n";
my $wild = File::Spec->catfile ( $fish_dir, "*.fish.txt" );
my $cnt = 0;
foreach my $f ( bsd_glob ( $wild ) ) {
print " $f\n";
++$cnt;
}
print "Found ${cnt} fish logs ...\n\n";
return ( $cnt );
}
# Cleans up after previous runs of this program ...
sub delete_old_fish_logs
{
my $wild_1 = File::Spec->catfile ( $fish_dir_summary, "*.fish.txt" );
my $wild_2 = File::Spec->catfile ( $fish_dir_details, "*.fish.txt" );
foreach my $f ( bsd_glob ( $wild_1 ), bsd_glob ( $wild_2 ) ) {
unlink ( $f );
}
return;
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
require Advanced::Config::Date;
=head1 DESCRIPTION
F<Advanced::Config::Date> is a helper module to L<Advanced::Config>. So it
should be very rare to directly call any methods defined by this module. But
it's perfectly OK to use this module directly if you wish.
It's main job is to handle parsing dates passed in various formats and languages
while returning it in the standardized format of: S<YYYY-MM-DD>. Hiding all the
messy logic of how to interprit any given date string.
=head1 MULTI-LANGUAGE SUPPORT
By default this module only supports parsing B<English> language dates.
But if you have the I<Date::Language> and/or I<Date::Manip> modules installed
you can ask for it to use another language supported by either of these modules
instead.
You have to explicitly allow languages that require the use of I<Wide Chars>.
lib/Advanced/Config/Date.pm view on Meta::CPAN
my $ok = shift;
my $msg = shift;
if ( $ok ) {
warn "==> ${msg}\n";
}
DBUG_VOID_RETURN ();
}
# ==============================================================
# No POD on purpose ...
# Does some common logic for swap_language() & init_special_date_arrays().
# Requires knowledge of the internals to Date::Language::<language>
# in order to work.
# This method should avoid referencing any global variables!
# Returns: undef or the references to the 5 arrays!
sub _swap_lang_common
{
DBUG_ENTER_FUNC ( @_ );
my $lang_ref = shift;
my $warn_ok = shift;
lib/Advanced/Config/Date.pm view on Meta::CPAN
foreach ( @lDoW, @lDoWs ) {
$issues{dow_period} = 1 if ( $_ =~ m/[.]/ );
}
DBUG_RETURN ( \@lMoY, \@lMoYs, \@lDsuf, \@lDoW, \@lDoWs, \%issues );
}
# ==============================================================
# No POD on purpose ...
# Does some common logic for swap_language() & init_special_date_arrays().
# Requires knowledge of the internals to Date::Manip::Lang::<language>
# in order to work.
# This method should avoid referencing any global variables!
# Returns: undef or the references to the 5 arrays!
# I would have broken it up ino multiple functions if not for the wide test!
sub _swap_manip_language_common
{
DBUG_ENTER_FUNC ( @_ );
my $lang_ref = shift;
lib/Advanced/Config/Examples.pm view on Meta::CPAN
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.
So today it's a powerfull tool that turns your config files into objects your
perl code can reference and manipulate.
lib/Advanced/Config/Examples.pm view on Meta::CPAN
# How about testing for a specific value for $ENV{test}? This can be
# done in a limited way.
message_abc = I know my abc's.
message_123 = I know my 123's
message_hello = Hello World!
msg = ${message_${test}:-Unknown Message.}
# So if test is "abc", "123" or "hello" it will use the appropriate
# value for tag msg. Otherwise it will be "Unknown Message.".
# This shows that you can put some logic in your config files so that
# your config files can be shared across platforms without having
# to have multiple versions of that config file or add complex platform
# specific logic into your perl code.
To load it into memory do:
my $cfg = Advanced::config->new ("complex.cfg")->load_config();
=item BREAKING YOUR CONFIG FILE INTO SECTIONS (section.cfg)
abc = lmn # Has no section, so considered in section "main".
user = me
pwd = nope!
lib/Advanced/Config/Examples.pm view on Meta::CPAN
user = you
Please note that section names are case insensitive and the tag abc's value
depends on what section of the config file you are currently looking at. This
way you may repeat tags between sections and know that each section is
independant of each other. As if each section was in it's own config file.
Or you can interpret each section as overrides to tags in the main section
using the B<inherit> option. Where if a tag isn't defined in the current
section, it then looks in the main section for it. Say you're on host 1 and
you want to log into your application. You need both a user & pwd pair to do
this. When you look up the pwd, you find it in host 1, but when you try to
look up the user, it can't find it in the current section, so it looks in the
main section for it instead. In effect all 4 sections have all variables from
main included in each section. With the local tags overriding what's in main.
A neet way to handle minor differences that would otherwise require you to
have multiple config files you'd need to keep in sync.
To load it into memory do:
my $cfg = Advanced::config->new ("section.cfg")->load_config();
lib/Advanced/Config/Options.pm view on Meta::CPAN
setting wrong means the file will be unusable as a config file.
B<disable_quotes> - Defaults to B<0>. Set to B<1> if you want to disallow
the stripping of balanced quotes in your config files.
B<disable_variables> - Defaults to B<0>. Set to B<1> if you want to disable
variable expansion in your config files when they are loaded into memory.
B<disable_variable_modifiers> - Defaults to B<0>. Set to B<1> if you want to
disable this feature. See L<http://wiki.bash-hackers.org/syntax/pe> for more
details. This feature allows you to put logic into your config files via
your variable definitions. Automtaically disabled when variables are
disabled. Usefull when you put a lot of special chars into your variable
names.
B<disable_decryption> - Defaults to B<0>. Set to B<1> if you want to disable
decrypting values that have been marked as encrypted. If a variable references
an encrypted value while disable_decription is active, that variable isn't
expanded.
=cut
lib/Advanced/Config/Options.pm view on Meta::CPAN
particular tag/value pair to perl's B<%ENV> hash. If the I<export> option
was also set, it inverts the meaning of this label to mean don't export it!
You can also gain the same functionality by doing one of the following
instead:
export tag = value # Optional unix type shell script prefix.
set tag = value # Optional windows type batch file prefix.
These prefixes allow you to easily use shell/batch files as config files if
they contain no logic.
B<hide_lbl> - Defaults to "B<HIDE>". Tells this module that this tag's value
contains sensitive information. So when fish logging is turned on, this module
will never write it to these logs. If the parser thinks a tag's name suggests
it's a password, it will assume that you put this label in the comment. This
is what triggers the sensitive/mask arguments and return values that some
methods use.
B<encrypt_lbl> - Defaults to "B<ENCRYPT>". Tells this module that you are
waiting for this tag's value to be encrypted in the config file. It assumes
the value is still in clear text. When present it assumes the value is
sensitive as well.
B<decrypt_lbl> - Defaults to "B<DECRYPT>". Tells this module that this value
lib/Advanced/Config/Options.pm view on Meta::CPAN
# The name of the default section ... (even if no sections are defined!)
use constant DEFAULT_SECTION_NAME => "main"; # Must be in lower case!
my %default_read_opts;
my %default_get_opts;
my %default_date_opts;
my @hide_from_fish;
# ==============================================================
# Get who you're currrently logged in as.
# Put here to avoid circular references between modules.
sub _get_user_id
{
DBUG_ENTER_FUNC ( @_ );
my $user = "??";
eval {
# Mostly used on unix like systms.
$user = getpwuid ($<) || "??";
};
if ( $@ ) {
# Can't use on unix due to sudo issue returns wrong user.
$user = getlogin () || "??";
}
DBUG_RETURN ($user);
}
# ==============================================================
# A stub of the source callback function ...
sub _source_callback_stub
{
DBUG_ENTER_FUNC ( @_ );
my $file = shift;
lib/Advanced/Config/Options.pm view on Meta::CPAN
}
}
}
DBUG_RETURN ( $def );
}
# ==============================================================
=item $str = convert_to_regexp_string ( $string[, $no_logs] )
Converts the passed string that may contain special chars for a Perl RegExp
into something that is a literal constant value to Perl's RegExp engine by
turning these problem chars into escape sequences.
It then returns the new string.
If I<$no_logs> is set to a non-zero value, it won't write anything to the logs.
=cut
sub convert_to_regexp_string
{
my $no_fish = $_[1];
DBUG_ENTER_FUNC ( @_ ) unless ( $no_fish );;
my $str = shift;
# The 8 problem chars with special meaning in a RegExp ...
lib/Advanced/Config/Options.pm view on Meta::CPAN
}
# ==============================================================
=item $sensitive = should_we_hide_sensitive_data ( $tag )
Checks the tag against an internal list of patterns to see if there is a match.
This check is done in a case insensitive way.
If there is a match it will return true and the caller should take care about
writing anything about this tag to any log files.
If there is no match it will return false, and you can write what you please to
your logs.
See I<make_it_sensitive> to add additional patterns to the list.
=cut
sub should_we_hide_sensitive_data
{
my $tag = shift;
my $skip_fish = shift; # Undocumented ...
lib/Advanced/Config/Options.pm view on Meta::CPAN
return ( $sensitive );
}
# ==============================================================
=item make_it_sensitive ( @patterns )
Add these pattern(s) to the internal list of patterns that this module considers
sensitive. Should any tag contain this pattern, that tag's value will be
masked when written to this module's internal logs. Leading/trailing spaces
will be ignored in the pattern. Wild cards are not honored.
The 3 default patterns are password, pass, and pwd.
This pattern affects all L<Advanced::Config> objects loaded into memory. Not
just the current one.
=cut
sub make_it_sensitive
lib/Advanced/Config/Options.pm view on Meta::CPAN
# ==============================================================
=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.
It calls B<warn> or B<die> with the message passed.
=cut
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# The label separators used when searching for option labels in a comment ...
my $lbl_sep = '[\s.,$!()-]';
# Initialize to the default secion ...
my $section = make_new_section ( $cfg, "" );
my %hide_section;
while ( <$READ_CONFIG> ) {
chomp;
my $line = $_; # Save so can use in fish logging later on.
my ($tv, $ln, $cmt, $lq, $rq) = parse_line ( $line, $opts );
if ( $ln eq "" ) {
DBUG_PRINT ("READ", "READ LINE: %s", $line);
next; # Skip to the next line if only comments found.
}
# Check for lines with no tag/value pairs in them ...
if ( ! $tv ) {
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# ==============================================================
=item ($v[, $h]) = expand_variables ( $config, $string[, $file[, $sensitive[, trim]]] )
This function takes the provided I<$string> and expands any embedded variables
in this string similar to how it's handled by a Unix shell script.
The optional I<$file> tells which file the string was read in from.
The optional I<$sensitive> when set to a non-zero value is used to disable
B<fish> logging when it's turned on because the I<$string> being passed contains
sensitive information.
The optional I<$trim> tells if you may trim the results before it's returned.
It returns the new value $v, once all the variable substitition(s) have occured.
And optionally a second return value $h that tells if B<fish> was paused during
the expansion of that value due to something being sensitive. This 2nd return
value $h is meaningless in most situations, so don't ask for it.
All variables are defined as B<${>I<...>B<}>, where I<...> is the variable you
wish to substitute. If something isn't surrounded by a B<${> + B<}> pair, it's
not a variable.
A config file exampe:
tmp1 = /tmp/work-1
tmp2 = /tmp/work-2
opt = 1
date = 2011-02-03
logs = ${tmp${opt}}/log-${date}.txt
date = 2012-12-13
So when passed "${tmp${opt}}/log-${date}.txt", it would return:
/tmp/work-1/log-2011-02-03.txt
And assigned it to B<logs>.
As you can see multiple variable substitutions may be expanded in a single
string as well as nested substitutions. And when the variable substitution is
done while reading in the config file, all the values used were defined before
the tag was referenced.
Should you call this method after the config file was loaded you get slightly
different results. In that case the final tag value is used instead and the
2nd date in the above example would have been used in it's place.
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$val = sprintf ($encrypt_fmt, ++$encrypt_cnt);
# If the place holder contains variable anchors abort the substitutions.
last if ( $val =~ m/${lv}/ || $val =~ m/${rv}/ );
$encrypt_vars{$val} = $tag;
$do_mod_lookup = 0;
}
# Doing some accounting to make sure any sensitive data doesn't
# show up in the fish logs from now on.
if ( $mask && ! $mask_flag ) {
$mask_flag = 1;
DBUG_PAUSE ();
DBUG_MASK ( 0 );
}
if ( $do_mod_lookup ) {
my $m;
($val, $m) = apply_modifier ( $config, $val, $mod_tag, $mod_opt, $mod_val, $file );
if ( $m == -2 ) {
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$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
} elsif ( $mod_opt eq "##" || $mod_opt eq "#" || # From beginning
$mod_opt eq "%%" || $mod_opt eq "%" ) { # From end
my $greedy = ( $mod_opt eq "##" || $mod_opt eq "%%" );
my $leading = ( $mod_opt eq "#" || $mod_opt eq "##" );
my $reverse_msg = ""; # Both the message & control flag ...
$output = $alt_val;
# Now replace shell script wildcards with their Perl equivalents.
# A RegExp can't do non-greedy replaces anchored to the end of string!
# So we need the reverse logic to do so.
my $regExpVal = convert_to_regexp_modifier ($mod_val);
$regExpVal =~ s/[?]/./g; # ? --> . (any one char)
if ( $greedy ) {
$regExpVal =~ s/[*]/.*/g; # * --> .* (zero or more greedy chars)
} elsif ( $leading ) {
$regExpVal =~ s/[*]/(.*?)/g; # * --> (.*?) (zero or more chars)
} elsif ( $regExpVal =~ m/[*]/ ) {
# Non-Greedy with one or more wild cards present ("*")!
$leading = 1; # Was false before.
$regExpVal = reverse ($regExpVal);
lib/Advanced/Config/Reader.pm view on Meta::CPAN
These 3 B<sub_*> return values will always be I<undef> should the variable
left/right anchors be overriden with the same value. Or if no modifiers
are detected in the tag's name.
If you've configured the module to be case insensitive (option B<tag_case>),
then both I<$tag> and I<$sub_tag> will be shifted to lower case for case
insensitive variable lookups.
Finally there is an 8th return value, I<$otag>, that contains the original
I<$tag> value before it was edited. Needed by F<parse_line> logic.
=cut
# WARNING: If (${lvar} == ${rvar}), nested variables are not supported.
# : And neither are variable modifiers. (The sub_* return values.)
# : So evaluate tags left to right.
# : If (${lvar} != ${rvar}), nested variables are supported.
# : So evaluate inner most tags first. And then left to right.
#
# RETURNS: 8 values. ( $left, $tag, $right, $cmt, $sub_tag, $sub_opr, $sub_val, $otag )
lib/Advanced/Config/Reader.pm view on Meta::CPAN
} elsif ( $tag =~ m/^!(.+)[@*]$/ ) {
# Using LIST for ${!var*} & ${!var@} opts since "!" has another meaning.
($sub_tag, $sub_opr, $sub_val) = ($1, "LIST", convert_to_regexp_string ($1));
$sub_tag =~ s/^\s+//;
# Rule: Indirect lookup ...
} elsif ( $tag =~ m/^!(.+)$/ ) {
($sub_tag, $sub_opr, $sub_val) = ($1, "!", "");
$sub_tag =~ s/^\s+//;
# Rule: Substitution logic ... ( / vs // )
# Anchors # or % supported but no RegExp wildcards are.
} elsif ( $tag =~ m#^(${not}+)(//?)([^/]+)/([^/]*)$# ) {
($sub_tag, $sub_opr, $sub_val, $sub_extra) = ($1, $2, $3, $4);
$sub_val = convert_to_regexp_string ($sub_val);
if ( $sub_val =~ m/^([#%])(.+)$/ ) {
$sub_val = $2;
$sub_val = ( $1 eq "#" ) ? "^${sub_val}/${sub_extra}" : "${sub_val}\$/${sub_extra}";
} else {
$sub_val = "${sub_val}/${sub_extra}";
}
$sub_val .= "/x";
# Rule: Another format for the Substitution logic ... ( / vs // )
} elsif ( $tag =~ m#^(${not}+)(//?)([^/]+)$# ) {
($sub_tag, $sub_opr, $sub_val, $sub_extra) = ($1, $2, $3, "");
$sub_val = convert_to_regexp_string ($sub_val);
if ( $sub_val =~ m/^([#%])(.+)$/ ) {
$sub_val = $2;
$sub_val = ( $1 eq "#" ) ? "^${sub_val}/${sub_extra}" : "${sub_val}\$/${sub_extra}";
} else {
$sub_val = "${sub_val}/${sub_extra}";
}
t/02-basic_parse_line_01_defaults.t view on Meta::CPAN
use_ok ( "Advanced::Config::Reader" );
use_ok ( "Advanced::Config::Options" );
DBUG_VOID_RETURN ();
}
END {
DBUG_ENTER_FUNC ();
# Don't do this test per done_testing() logic!
# dbug_ok (1, "In the END block!"); # Last test.
DBUG_VOID_RETURN ();
}
# For overriding the fish mask in parse_line().
my $oTag = "DBUG_TEST_USE_CASE_PARSE_OVERRIDE";
my $opts;
my $assign;
t/02-basic_parse_line_02_overrides.t view on Meta::CPAN
use_ok ( "Advanced::Config::Reader" );
use_ok ( "Advanced::Config::Options" );
DBUG_VOID_RETURN ();
}
END {
DBUG_ENTER_FUNC ();
# Don't do this test per done_testing() logic!
# dbug_ok (1, "In the END block!"); # Last test.
DBUG_VOID_RETURN ();
}
# For overriding the fish mask in parse_line().
my $oTag = "DBUG_TEST_USE_CASE_PARSE_OVERRIDE";
my $opts;
my $assign;
t/02-basic_parse_line_03_same_start_stop.t view on Meta::CPAN
use_ok ( "Advanced::Config::Reader" );
use_ok ( "Advanced::Config::Options" );
DBUG_VOID_RETURN ();
}
END {
DBUG_ENTER_FUNC ();
# Don't do this test per done_testing() logic!
# dbug_ok (1, "In the END block!"); # Last test.
DBUG_VOID_RETURN ();
}
# For overriding the fish mask in parse_line().
my $oTag = "DBUG_TEST_USE_CASE_PARSE_OVERRIDE";
my $opts;
my $assign;
t/10-validate_simple_cfg.t view on Meta::CPAN
"c" => "C is for Cat!",
"d" => "D is for Dog!",
"e" => "E is for Elephant!",
"f" => "'F is for Frog!" . '"',
"g" => '$fooled you',
"h_pwd" => 'Hello World!',
"one" => "ONE", "two" => "TWO", "three" => "THREE",
"number 1" => "ONE TWO THREE",
"rule5_pid" => $$, "rule5_prog" => $0, "rule5_os" => $^O,
"rule6_host" => hostname(),
# "rule6_user" => getlogin () || getpwuid ($<) || "??",
"rule6_user" => Advanced::Config::Options::_get_user_id (),
"rule6_pid" => $$,
"rule6_p" => basename ($0, ".t"),
"rule6_sep" => $sep,
"cmt" => $opts->{comment},
"empty_1" => '',
"empty_2" => '',
"empty_3" => 'abc xyz',
"empty_4" => 'abc xyz',
"rule8 missing" => ""
t/10-validate_simple_cfg.t view on Meta::CPAN
$values{"number 3"} = $values{"number 1"};
$values{"number 4"} = $values{"number 1"};
$values{"number 5"} = $values{"number 1"};
$values{"number 6"} = $values{"number 1"};
$values{"number 8"} = $values{"number 1"};
$values{cmt2} = $values{cmt} . $values{cmt};
$values{cmt3} = $values{cmt} . $values{cmt} . $values{cmt};
# Handles rules 6 & 7 combined ...
$values{log1} = File::Spec->catfile ("t", "logs", $values{rule6_p} . ".");
$values{log3} = $values{log1} . $dates{tomorrow} . ".txt";
$values{log2} = $values{log1} . $dates{yesterday} . ".txt";
$values{log1} .= $dates{today} . ".txt";
eval {
$values{rule6_ppid} = getppid ();
};
if ( $@ ) {
$values{rule6_ppid} = "-1";
}
my $total = keys %values;
t/20-validate_encrypt_decrypt.t view on Meta::CPAN
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;
# =================================================================
# 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 ();
t/20-validate_encrypt_decrypt.t view on Meta::CPAN
# Encrypting the file ...
DBUG_PRINT ("====", "%s", "="x50);
my $status = $emptyCfg->encrypt_config_file ($orig_file, $encrypt_file, $rOpts);
dbug_is ($status, 1, "Encryption Succeeded!");
# Reload the encrypted file back into memory ...
DBUG_PRINT ("====", "%s", "="x50);
my $ecfg = init_cfg_file ( $encrypt_file, \%aOpts );
# Saves a list of tags to be decrypted ...
# Set via the callback function for the encrypt/decrypt logic.
my %save = %decrypt_callback_tags;
# Loading using a bad alias ...
DBUG_PRINT ("====", "%s", "="x50);
my $ecfg2 = init_cfg_file ( $encrypt_file, $rOpts );
# Decrypting the file correctly ...
DBUG_PRINT ("====", "%s", "="x50);
$status = $emptyCfg->decrypt_config_file ($encrypt_file, $file_decrypt, \%aOpts);
dbug_is ($status, 1, "Decryption Succeeded!");
t/28-sensitive_tests.t view on Meta::CPAN
Advanced::Config::Options::make_it_sensitive ("pork");
my @sections = $cfg1->find_sections ();
my $cnt = @sections;
dbug_is ($cnt, 3, "All 3 sections were accounted for!");
my @tag_list = $cfg1->find_tags ();
$cnt = @tag_list;
# --------------------------------------------------------------
# Section # 1: Normal operation, validating the sensitive logic.
# All tags considered sensitive end in "_y" for this test.
# Or if a section name is sensitive everything in
# it is sensitive!
# --------------------------------------------------------------
foreach my $s ( @sections ) {
dbug_ok (1, "-"x50);
my $lCfg = $cfg1->get_section ( $s );
my @tags = $lCfg->find_tags ();
my $tlt = @tags;
t/30-alt_symbols_cfg.t view on Meta::CPAN
# Should never find anything!
foreach ( @dst_list ) {
next if ( $list{$_} );
dbug_ok (0, "Found unexpected tag '$_' in new config file.");
}
DBUG_VOID_RETURN ();
}
# ====================================================================
# Common initialization logic for each config file loaded into memory!
sub initialize_config
{
DBUG_ENTER_FUNC (@_);
my $file = shift;
my $ropts = shift;
my $gopts = shift;
my $dopts = shift;
my $space_sep = is_assign_spaces ( $ropts );
t/75-check_all_languages.t view on Meta::CPAN
$wide -= 4; # Now: -4, -5, -6 or -7 ...
}
}
my $utf8 = utf8::is_utf8 ($_) || 0; # After ...
$lang_wide = $lang_wide || $wide;
$lang_utf8 = $lang_utf8 || $utf8;
++$has_spaces if ( $_ =~ m/\s/ );
}
# So I can log my results ...
# And prove my assumptions are good!
my $test_ok = ( scalar (@lMoY) == 12 && scalar (@lMoYs) == 12 );
DBUG_PRINT ($test_ok ? "INFO" : "BAD",
"MoY: %d, MoYs: %d, Dsuf: %02d, DoW: %d, DoWs: %d, wide(%2d), utf8(%d), uses_utf8_mod(%s), spaces(%2d), Language: %s",
scalar (@lMoY), scalar (@lMoYs), scalar (@lDsuf), scalar (@lDoW), scalar (@lDoWs),
$lang_wide, $lang_utf8, $uses_utf8_mod ? "YES" : "no", $has_spaces, $lang);
if ( $test_ok ) {
my %data = ( MoY => \@lMoY, MoYs => \@lMoYs,
t/76-check_all_languages2.t view on Meta::CPAN
foreach my $d (1..7) {
my $w = $langData->{day_name}->[$d - 2]->[0]; # The 1st entry.
my ($wd, $before, $after, $spaces) = fix_key ($w);
push (@DoW, $wd);
$w = $langData->{day_abb}->[$d - 2]->[0]; # The 1st entry.
($wd, $before, $after, $spaces) = fix_key ($w);
push (@DoWs, $wd);
}
# So I can log my results ...
# And prove my assumptions are good!
DBUG_PRINT ("INFO", "MoY: %d, Dsuf: %02d, DoW: %d, wide(%2d), utf8(%d), spaces(%2d/%2d/%2d), Language: %s/%s",
scalar (keys %months), scalar (keys %days), scalar (keys %wdays), $lang_wide, $lang_utf8, $mon_spaces, $day_spaces, $wday_spaces, $mod, $Language);
my %data = ( hMoY => \%months, hDsuf => \%days, hDoW => \%wdays,
MoY => \@MoY, Dsuf => \@Dsuf, DoW => \@DoW,
MoYs => \@MoYs, DoWs => \@DoWs,
wide => $lang_wide, utf8 => $lang_utf8,
lang => $Language, module => $module,
t/config/10-simple.cfg view on Meta::CPAN
rule6_host = ${hostname}
rule6_user = ${user}
rule6_pid = ${PID} # Should match ${rule5_pid}
rule6_ppid = ${PPID} # Different per test ...
rule6_p = ${program}
rule6_sep = ${sep} # Varies by OS
# Here are some dates we are interested in!
# The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 = t${sep}logs${sep}${program}.${today}.txt
log2 = t${sep}logs${sep}${program}.${yesterday}.txt
log3 = t${sep}logs${sep}${program}.${tomorrow}.txt
# Here are some strange variables to see what happens!
empty_1 = ${}
empty_2 = ${ }
empty_3 = abc ${} xyz
empty_4 = abc ${ } xyz
t/config/13-alt-get-tests.cfg view on Meta::CPAN
boolean_12_1 = ${boolean_05_1}
boolean_13_1 = On
boolean_13_0 = Off
boolean_14_0 = o # Ambiguous, so will evalute to false!
boolean_15_0 = .0
boolean_15_1 = .1
# ----------------------------------------------------------------------
# Used to test the get_directory() get_list_directory() functions ...
# ----------------------------------------------------------------------
which0 = log_summary
which1 = log_details
which = ${which${ADVANCED_CONFIG_FISH}:=${which0}}
dir_1 = t
dir_2 = ${dir_1}${sep}config
dir_3 = ${dir_1}${sep}${which}
dir_bad_1 = ${dir_1}${sep}no_such_dir # No such dir or file!
dir_bad_2 = ${dir_2}${sep}13-alt-get-tests.cfg # This config file is not a directory!
dir_list_1 = ${dir_1} ${dir_2} ${dir_3}
dir_list_2 = ${dir_1} ${dir_bad_1} ${dir_3} ${dir_bad_2}
t/config/30-alt_symbols_01.cfg view on Meta::CPAN
rule6_host == $[hostname]
rule6_user == $[user]
rule6_pid == $[PID] : Should match $[rule5_pid]
rule6_ppid == $[PPID] : Different per test ...
rule6_p == $[program]
rule6_sep == $[sep] : Varies by OS
: Here are some dates we are interested in!
: The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 == t$[sep]logs$[sep]$[program].$[today].txt
log2 == t$[sep]logs$[sep]$[program].$[yesterday].txt
log3 == t$[sep]logs$[sep]$[program].$[tomorrow].txt
: Here are some strange variables to see what happens!
empty_1 == $[]
empty_2 == $[ ]
empty_3 == abc $[] xyz
empty_4 == abc $[ ] xyz
t/config/30-alt_symbols_02.cfg view on Meta::CPAN
rule6_host == %hostname%
rule6_user == %user%
rule6_pid == %PID% = Should match %rule5_pid%
rule6_ppid == %PPID% = Different per test ...
rule6_p == %program%
rule6_sep == %sep% = Varies by OS
= Here are some dates we are interested in!
= The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 == t%sep%logs%sep%%program%.%today%.txt
log2 == t%sep%logs%sep%%program%.%yesterday%.txt
log3 == t%sep%logs%sep%%program%.%tomorrow%.txt
= Here are some strange variables to see what happens!
empty_1 == %%
empty_2 == % %
empty_3 == abc %% xyz
empty_4 == abc % % xyz
t/config/30-alt_symbols_03.cfg view on Meta::CPAN
rule6_host := $[hostname]
rule6_user := $[user]
rule6_pid := $[PID] ? Should match $[rule5_pid]
rule6_ppid := $[PPID] ? Different per test ...
rule6_p := $[program]
rule6_sep := $[sep] ? Varies by OS
? Here are some dates we are interested in!
? The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 := t$[sep]logs$[sep]$[program].$[today].txt
log2 := t$[sep]logs$[sep]$[program].$[yesterday].txt
log3 := t$[sep]logs$[sep]$[program].$[tomorrow].txt
? Here are some strange variables to see what happens!
empty_1 := $[]
empty_2 := $[ ]
empty_3 := abc $[] xyz
empty_4 := abc $[ ] xyz
t/config/30-alt_symbols_04 multi section test.cfg view on Meta::CPAN
rule6_host ~ $<hostname>
rule6_user ~ $<user>
rule6_pid ~ $<PID> CMT: Should match $<rule5_pid>
rule6_ppid ~ $<PPID> CMT: Different per test ...
rule6_p ~ $<program>
rule6_sep ~ $<sep> CMT: Varies by OS
CMT: Here are some dates we are interested in!
CMT: The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 ~ t$<sep>logs$<sep>$<program>.$<today>.txt
log2 ~ t$<sep>logs$<sep>$<program>.$<yesterday>.txt
log3 ~ t$<sep>logs$<sep>$<program>.$<tomorrow>.txt
CMT: Here are some strange variables to see what happens!
empty_1 ~ $<>
empty_2 ~ $< >
empty_3 ~ abc $<> xyz
empty_4 ~ abc $< > xyz
CMT: -------------------------------------------------------------
t/config/30-alt_symbols_04 multi section test.cfg view on Meta::CPAN
rule5_prog ~ $<$<section_01>.rule5_prog>
rule5_os ~ $<$<section_01>.rule5_os>
rule6_host ~ $<$<section_01>.rule6_host>
rule6_user ~ $<$<section_01>.rule6_user>
rule6_pid ~ $<$<section_01>.rule6_pid>
rule6_ppid ~ $<$<section_01>.rule6_ppid>
rule6_p ~ $<$<section_01>.rule6_p>
rule6_sep ~ $<$<section_01>.rule6_sep>
log1 ~ $<$<section_01>.log1>
log2 ~ $<$<section_01>.log2>
log3 ~ $<$<section_01>.log3>
empty_1 ~ $<$<section_01>.empty_1>
empty_2 ~ $<$<section_01>.empty_2>
empty_3 ~ $<$<section_01>.empty_3>
empty_4 ~ $<$<section_01>.empty_4>
t/config/30-alt_symbols_05 space assign.cfg view on Meta::CPAN
rule6_host $[hostname]
rule6_user $[user]
rule6_pid $[PID] : Should match $[rule5_pid]
rule6_ppid $[PPID] : Different per test ...
rule6_p $[program]
rule6_sep $[sep] : Varies by OS
: Here are some dates we are interested in!
: The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 t$[sep]logs$[sep]$[program].$[today].txt
log2 t$[sep]logs$[sep]$[program].$[yesterday].txt
log3 t$[sep]logs$[sep]$[program].$[tomorrow].txt
: Here are some strange variables to see what happens!
empty_1 $[]
empty_2 $[ ]
empty_3 abc $[] xyz
empty_4 abc $[ ] xyz
t/config/30-alt_symbols_80_overlap.cfg view on Meta::CPAN
rule6_ppid = ${PPID} # Different per test ...
rule6_p = ${program}
rule6_sep = ${sep} # Varies by OS
# --------------------------------------------------------------
[ main ]
# Here are some dates we are interested in!
# The date keywords use rule 7 ... So mixes rule 6 & 7.
log1 = t${sep}logs${sep}${program}.${today}.txt
log2 = t${sep}logs${sep}${program}.${yesterday}.txt
log3 = t${sep}logs${sep}${program}.${tomorrow}.txt
# Here are some strange variables to see what happens!
empty_1 = ${}
empty_2 = ${ }
empty_3 = abc ${} xyz
empty_4 = abc ${ } xyz
[ duplicate ]
log1 = t${sep}logs${sep}${program}.${today}.txt
log2 = t${sep}logs${sep}${program}.${yesterday}.txt
log3 = t${sep}logs${sep}${program}.${tomorrow}.txt
empty_1 = ${}
empty_2 = ${ }
empty_3 = abc ${} xyz
empty_4 = abc ${ } xyz
[ variable ]
log1 = t${sep}logs${sep}${program}.${today}.txt
log2 = t${sep}logs${sep}${program}.${yesterday}.txt
log3 = t${sep}logs${sep}${program}.${tomorrow}.txt
empty_1 = ${}
empty_2 = ${ }
empty_3 = abc ${} xyz
empty_4 = abc ${ } xyz
# -------------------------------------------------------
# Defines the variables to look up for 30-alt_symbol_control.cfg
t/test-helper/helper1234.pm view on Meta::CPAN
# So default is to use fish if environment variable isn't set!
my $on = ( $ENV{FISH_OFF_FLAG} ) ? 0 : 1;
# %ENV var that controls whether this module uses fish or not ...
my $fish_tag = 'ADVANCED_CONFIG_FISH';
my $msg;
if ( $on ) {
$ENV{$fish_tag} = 1;
$msg = "Fish has been turned on for Advanced::Config ...";
$fish = File::Spec->catfile (dirname ($fish), "log_details", basename ($fish));
} else {
delete ( $ENV{$fish_tag} );
$msg = "Fish has been disabled for Advanced::Config ...";
$fish = File::Spec->catfile (dirname ($fish), "log_summary", basename ($fish));
}
DBUG_PRINT ("INFO", "\n%s\n ", $msg);
DBUG_RETURN ( $fish );
}
# Returns the hash if not empty or undef.
sub print_opts_hash
{
( run in 1.117 second using v1.01-cache-2.11-cpan-49f99fa48dc )