Advanced-Config
view release on metacpan or search on metacpan
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;
full_developer_test.pl.src view on Meta::CPAN
# 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;
}
# Tries to find out the proper 'make' program to use for your platform ...
# Then runs it. If it exits with a non-zero status it assumes it's the
# wrong one and tries out the next one in the list!
lib/Advanced/Config/Date.pm view on Meta::CPAN
=over 4
=cut
package Advanced::Config::Date;
use strict;
use warnings;
use File::Spec;
use File::Glob qw (bsd_glob);
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
use Exporter;
use Fred::Fish::DBUG 2.09 qw / on_if_set ADVANCED_CONFIG_FISH /;
$VERSION = "1.12";
@ISA = qw( Exporter );
@EXPORT = qw( get_languages
swap_language
lib/Advanced/Config/Date.pm view on Meta::CPAN
make_it_a_4_digit_year
parse_8_digit_date
parse_6_digit_date
init_special_date_arrays
_date_language_installed
_date_manip_installed
);
@EXPORT_OK = qw( );
my $global_cutoff_date = 30; # Defaults to 30 years in the future ...
# Thesee haahes tell which language modules are available ...
my %date_language_installed_languages;
my %date_manip_installed_languages;
# ========================================================================
# Detects if the optional Date::Language module is available ...
# If it's not installed, you'll be unable to swap languages using it!
BEGIN
{
lib/Advanced/Config/Date.pm view on Meta::CPAN
local $SIG{__DIE__} = "";
require Date::Language;
# Find out where it's installed
my $loc = $INC{"Date/Language.pm"};
$loc =~ s/[.]pm$//;
my $search = File::Spec->catfile ($loc, "*.pm");
# Get's the list of languages supported.
foreach my $f ( bsd_glob ($search) ) {
my $module = (File::Spec->splitdir( $f ))[-1];
$module =~ s/[.]pm$//;
my %data = ( Language => $module,
Module => "Date::Language::${module}" );
$date_language_installed_languages{lc($module)} = \%data;
}
};
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
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;
my $allow_wide = shift || 0;
my $base = "Date::Language";
lib/Advanced/Config/Date.pm view on Meta::CPAN
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;
my $warn_ok = shift;
my $allow_wide = shift || 0;
lib/Advanced/Config/Date.pm view on Meta::CPAN
So assuming one of the language modules are intalled, it asks it for the list of
months in the requested language. And once that list is retrieved only months
in that language are supported when parsing a date string.
Languages like 'Greek' that rely on I<Wide Chars> require the I<$wide> flag set to
true. Otherwise that language is disabled. Using the I<use_ut8> option when
creating the Advanced::Config object causes the I<$wide> flag to be set to B<1>.
=cut
# NOTE: Sets the following global variables for use by parse_date() ...
# %last_language_edit_flags
# %Months
# %Days
sub swap_language
{
DBUG_ENTER_FUNC ( @_ );
my $lang = shift;
my $warn_ok = shift;
my $allow_wide = shift || 0;
lib/Advanced/Config/Date.pm view on Meta::CPAN
This affects all L<Advanced::Config> objects, not just the current one.
=cut
sub adjust_future_cutoff
{
DBUG_ENTER_FUNC ( @_ );
my $years = shift;
if ( defined $years && $years =~ m/^\d+$/ ) {
$global_cutoff_date = shift;
}
DBUG_VOID_RETURN ();
}
# ==============================================================
=item $year = make_it_a_4_digit_year ( $two_digit_year );
lib/Advanced/Config/Date.pm view on Meta::CPAN
{
DBUG_ENTER_FUNC ( @_ );
my $year = shift || 0; # Passed as a 2-digit year ...
$year += 2000; # Convert it to a 4-digit year ...
# Get the current 4-digit year ...
my $this_yr = (localtime (time()))[5];
$this_yr += 1900;
if ( $this_yr < $year && ($year - $this_yr) >= $global_cutoff_date ) {
$year -= 100; # Make it last century instead.
}
DBUG_RETURN ( $year );
}
# ==============================================================
=item ($year, $month, $day) = parse_8_digit_date ( $date_str, $order[, $skip] );
lib/Advanced/Config/Date.pm view on Meta::CPAN
}
}
if ( $lang_ref ) {
($MoY_ref, $MoYs_ref, $Dsuf_ref, $DoW_ref, $DoWs_ref) =
_swap_lang_common ( $lang_ref, $warn_ok, $allow_wide );
$lang = $lang_ref->{Language};
}
# If the new language was valid, update the global variables ...
if ( $MoY_ref ) {
$prev_array_lang = $lang;
@gMoY = @{$MoY_ref};
@gMoYs = map { uc($_) } @{$MoYs_ref};
@gDoW = @{$DoW_ref};
@gDoWs = map { uc($_) } @{$DoWs_ref};
@gDsuf = @{$Dsuf_ref};
DBUG_PRINT ( "LANGUAGE", "%s\n%s\n%s\n%s\n%s",
join (", ", @gMoY), join (", ", @gMoYs),
lib/Advanced/Config/Options.pm view on Meta::CPAN
=pod
B<trap_recursion> - Defaults to B<0>. Set to B<1> if you want to treat
recursion as a fatal error when loading a config file. By default it just
ignores the recursion request to prevent infinite loops.
B<source_cb_opts> - A work area for holding values between calls to the
callback function. This is expected to be a hash reference to provide any
needed configuration values needed to parse the next config file. This way
you can avoid global varibles. Defaults to an empty hash reference.
B<source_cb> - An optional callback routine called each time your config file
sources in another config file. It's main use is when the I<Read Options>
and/or I<Date Format Options> required to parse each config file change between
files. It's automatically called right before the sourced in file is opened up
for parsing.
Once the new file is sourced in, it inherits most of the options currently used
unless you override them. The only ones not inherited deal with decryption.
lib/Advanced/Config/Options.pm view on Meta::CPAN
B<inherit_pass_phrase> - Defaults to 0 (no). Set to 1 if you want to use the
same B<pass_pharase> when you source in a sub-file in your config files.
B<encrypt_by_user> - Defaults to 0 (no). Set to 1 if you want use the user
name you are running the program under as part of the encryption key. So only
the user who encryted the file can decrypt it.
B<encrypt_cb_opts> - A work area for holding values between calls to the
callback function. This is expected to be a hash reference to provide any
values needed by your encryption efforts. So you can avoid global variables
and having to figure out the correct context of the call. Defaults to an empty
hash reference.
B<encrypt_cb> - An optional callback function to provide hooks for B<true
encryption> or an additional layer of masking. It defaults to no callback
function used. This callback function is called in addition to any obscuring
work done by this module.
Here is the callback function's expected definition:
lib/Advanced/Config/Options.pm view on Meta::CPAN
=head2 Z<>
=head1 The Get Options
This section deals with the options you can use to override how the I<B<get>>
methods behave when you try to access the values for individual tags. None
of the options below allows leading or trailing spaces in it's value. If any
are found, they will be automatically trimmed off before their value is used.
Internal spaces are OK.
These options can be set as global defaults via the call to the constructor,
B<new()>, or for individual B<get_...> calls if you don't like the defaults
for individual calls.
But it is strongly recomended that the B<inherit> option only be set in the
constructor and not changed elsewhere. Changing it's value beween calls can
cause strange behavior if you do so. Since it globally affects how this
module locates the requested tag and affects variable lookups when the
config file is parsed.
After that, where to set the other options is more a personal choice than
anything else.
=over 4
B<inherit> - Defaults to B<0> where each section is independent, the tag either
exists or it doesn't in the section. Set to B<1> if each section should be
lib/Advanced/Config/Options.pm view on Meta::CPAN
my $tag = shift;
my $value = shift; # Clear text sensitive value ...
my $file = shift;
my $cbOpts = shift;
DBUG_MASK ( 0 );
DBUG_RETURN ( $value );
}
# ==============================================================
# Initialize the global hashes with their default values ...
BEGIN
{
DBUG_ENTER_FUNC ();
# ---------------------------------------------------------------------
# Make sure no hash value is undef !!!
# ---------------------------------------------------------------------
# You can only add to this list, you can't remove anything from it!
# See should_we_hide_sensitive_data () on how this list is used.
DBUG_PRINT ("INFO", "Initializing the tag patterns to hide from fish ...");
push ( @hide_from_fish, "password" );
push ( @hide_from_fish, "pass" );
push ( @hide_from_fish, "pwd" );
# ---------------------------------------------------------------------
DBUG_PRINT ("INFO", "Initializing the READ options global hash ...");
# Should always be set in the constructor ...
$default_read_opts{tag_case} = 0; # Case sensitive tags.
# The generic options ...
my %src_empty;
$default_read_opts{croak} = 0; # Don't croak by default.
$default_read_opts{export} = 0; # Don't export any tag/val pairs.
$default_read_opts{use_utf8} = 0; # Doesn't support utf8/Unicode/Wide Chars.
$default_read_opts{disable_quotes} = 0; # Don't disable balanced quotes.
$default_read_opts{disable_variables} = 0; # Don't disable variables!
lib/Advanced/Config/Options.pm view on Meta::CPAN
# Special undocumented test prog option for overriding fish in parse_line().
$default_read_opts{dbug_test_use_case_parse_override} = 0; # Always off.
# Special undocumented test prog option for overriding fish in read_config().
$default_read_opts{dbug_test_use_case_hide_override} = 0; # Always off.
# ---------------------------------------------------------------------
DBUG_PRINT ("INFO", "Initializing the GET options global hash ...");
# Should always be set in the constructor ...
$default_get_opts{inherit} = 0; # Can inherit from the parent section.
# The generic options ... Who cares where set!
$default_get_opts{required} = 0; # Return undef by default.
$default_get_opts{vcase} = 0; # Case of the value. (0 = as is)
$default_get_opts{split_pattern} = qr /\s+/; # Space separated lists.
# Used in parsing dates for get_date() ...
$default_get_opts{date_language} = "English"; # The language to use in parsing dates.
lib/Advanced/Config/Options.pm view on Meta::CPAN
$default_get_opts{auto_true} = 0; # Don't return as boolean.
$default_get_opts{filename} = 0; # Tag doesn't do a file test.
$default_get_opts{directory} = 0; # Tag doesn't do a directory test.
$default_get_opts{split} = 0; # Don't split the value.
$default_get_opts{sort} = 0; # Don't sort the split value. (1 - sort, -1 - reverse sort)
$default_get_opts{date_active} = 0; # 0-No, 1-Yes expecing it to be a date.
# ---------------------------------------------------------------------
DBUG_PRINT ("INFO", "Initializing the DATE formatting options global hash ...");
$default_date_opts{date_order} = 0; # 0 - YMD, 1 - MDY, 2 - DMY
$default_date_opts{date_sep} = "-"; # Separator to format dates with.
$default_date_opts{month_type} = 0; # 0 - numeric, 1 - abbreviate, 2 - full.
$default_date_opts{month_language} = "English"; # See Date::Language.
$default_date_opts{use_gmt} = 0; # 0 - localtime, 1 - gmtime.
# $default_date_opts{timestamp} = ?; # Special case can't set directly.
# ---------------------------------------------------------------------
lib/Advanced/Config/Reader.pm view on Meta::CPAN
@ISA = qw( Exporter );
@EXPORT = qw( read_config source_file make_new_section parse_line
expand_variables apply_modifier parse_for_variables
format_section_line format_tag_value_line format_encrypt_cmt
encrypt_config_file_details decrypt_config_file_details );
@EXPORT_OK = qw( );
my $skip_warns_due_to_make_test;
my %global_sections;
my $gUserName;
# ==============================================================
# NOTE: It is extreemly dangerous to reference Advanced::Config
# internals in this code. Avoid where possible!!!
# Ask for copies from the module instead.
# ==============================================================
# Any other module initialization done here ...
# This block references initializations done in my other modules.
BEGIN
{
DBUG_ENTER_FUNC ();
# What we call our default section ...
$global_sections{DEFAULT} = Advanced::Config::Options::DEFAULT_SECTION_NAME;
$global_sections{OVERRIDE} = $global_sections{DEFAULT};
$gUserName = Advanced::Config::Options::_get_user_id ();
# Is the code being run via "make test" environment ...
if ( $ENV{PERL_DL_NONLAZY} ||
$ENV{PERL_USE_UNSAFE_INC} ||
$ENV{HARNESS_ACTIVE} ) {
$skip_warns_due_to_make_test = 1;
}
lib/Advanced/Config/Reader.pm view on Meta::CPAN
sub source_file
{
DBUG_ENTER_FUNC (@_);
my $cfg = shift;
my $defaultSection = shift; # The new default section if not "".
my $new_file = shift; # May contain variables to expand ...
my $old_file = shift; # File we're currently parsing. (has abs path)
my $rOpts = $cfg->get_cfg_settings (); # The Read Options ...
local $global_sections{OVERRIDE} = $defaultSection if ( $defaultSection );
my $pcfg = $cfg->get_section (); # Back to the main/default section ...
my $file = $new_file = expand_variables ($pcfg, $new_file, undef, undef, 1);
# Get the full name of the file we're sourcing in ...
$file = $pcfg->_fix_path ( $file, dirname ( $old_file ) );
unless ( -f $file && -r _ ) {
my $msg = "No such file to source in or it's unreadable ( $file )";
lib/Advanced/Config/Reader.pm view on Meta::CPAN
=cut
sub make_new_section
{
DBUG_ENTER_FUNC (@_);
my $config = shift;
my $new_name = shift;
# Check if overriding the default section with a new name ...
if ( $new_name eq "" || $new_name eq $global_sections{DEFAULT} ) {
if ( $global_sections{DEFAULT} ne $global_sections{OVERRIDE} ) {
DBUG_PRINT ("OVERRIDE", "Overriding section '%s' with section '%s'",
$new_name, $global_sections{OVERRIDE});
$new_name = $global_sections{OVERRIDE};
}
}
my $pcfg = $config->get_section (); # Back to the main section ...
my $val = expand_variables ($pcfg, $new_name, undef, undef, 1);
$new_name = lc ( $val );
# Check if the section name is already in use ...
my $old = $pcfg->get_section ( $new_name );
t/20-validate_encrypt_decrypt.t view on Meta::CPAN
# =================================================================
sub init_cfg_file
{
DBUG_ENTER_FUNC (@_);
my $file = shift;
my $rOpts = shift;
my %empty;
# Empty out the global hashes ...
%decrypt_callback_tags = %encrypt_callback_tags = %empty;
my $cfg;
eval {
if ( $rOpts ) {
$cfg = Advanced::Config->new ( $file, $rOpts );
} else {
$cfg = Advanced::Config->new ( $file, { encrypt_cb => \&my_security_callback } );
}
dbug_isa_ok ($cfg, 'Advanced::Config');
t/30-alt_symbols_cfg.t view on Meta::CPAN
# 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);
}
# ====================================================================
# This is the source_cb callback function named in: 30-alt_symbol_control.cfg
# All it does is lookup the options to use from the
# appropriate section in the conig file. (global var)
sub ALTER_SOURCE_CALLBACK_OPTIONS
{
DBUG_ENTER_FUNC (@_);
my $file = shift;
my $custom = shift;
my $f = basename ($file);
DBUG_ENTER_BLOCK ("GRAB");
DBUG_PAUSE();
t/75-check_all_languages.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use File::Basename;
use File::Spec;
use File::Glob qw (bsd_glob);
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;
# ---------------------------------------------------------------------
# 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 {
# The config file this program is to create!
$config_file_normal = File::Spec->catfile (dirname ($0), "config", "75-all_languages_normal.cfg");
$config_file_wide = File::Spec->catfile (dirname ($0), "config", "75-all_languages_wide.cfg");
unlink ( $config_file_normal, $config_file_wide );
$fish = turn_fish_on_off_for_advanced_config ();
t/75-check_all_languages.t view on Meta::CPAN
}
# Lookup where to find the Language modules ...
my $key = File::Spec->catfile ("Date", "Language") . ".pm";
my $lang_dir = $INC{$key};
$lang_dir = $INC{'Date/Language.pm'} unless ($lang_dir);
$lang_dir =~ s/[.]pm$//;
my $search = File::Spec->catdir ($lang_dir, "*.pm");
# Get's the list of languages supported.
foreach my $f ( bsd_glob ($search) ) {
my @dirs = File::Spec->splitdir ($f);
$dirs[-1] =~ s/[.]pm//;
push (@global_languages, $dirs[-1]);
push (@global_lang_use_utf8, uses_utf8_module ($f));
}
if ( $#global_languages == -1 ) {
dbug_ok (1, "No Date::Language::<lang> modules are installed. Skipping this test!");
done_testing ();
DBUG_LEAVE (0);
}
# Now load all those modules ...
foreach my $l ( @global_languages ) {
my $module = "Date::Language::${l}";
use_ok ($module);
}
DBUG_VOID_RETURN ();
}
END {
DBUG_ENTER_FUNC ();
# Don't do any tests in the END block ...
t/75-check_all_languages.t view on Meta::CPAN
}
# ====================================================================
sub load_all_language_data
{
DBUG_ENTER_FUNC (@_);
my %lang_data;
my $lidx = 0;
foreach my $lang ( @global_languages ) {
my $uses_utf8_mod = $global_lang_use_utf8[$lidx++];
my $module = "Date::Language::${lang}";
my ( $lang_wide, $lang_utf8 ) = ( 0, 0 );
# @Dsuf isn't always available for some modules.
my @lMoY = eval "\@${module}::MoY"; # The fully spelled out Months.
my @lMoYs = eval "\@${module}::MoYs"; # The legal Abbreviations.
my @lDsuf = eval "\@${module}::Dsuf"; # The suffix for the Day of Month. (buggy)
my @lDoW = eval "\@${module}::DoW"; # The Day of Week.
my @lDoWs = eval "\@${module}::DoWs"; # The Day of Week Abbreviations.
t/76-check_all_languages2.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use File::Basename;
use File::Spec;
use File::Glob qw (bsd_glob);
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;
# ---------------------------------------------------------------------
# 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!
$config_file_normal = File::Spec->catfile (dirname ($0), "config", "76-all_languages_normal-2.cfg");
$config_file_wide = File::Spec->catfile (dirname ($0), "config", "76-all_languages_wide-2.cfg");
unlink ( $config_file_normal, $config_file_wide );
$fish = turn_fish_on_off_for_advanced_config ();
t/76-check_all_languages2.t view on Meta::CPAN
if ($@) {
dbug_ok (1, "Date::Manip::Lang::index is not installed. This version of Date::Manip (v${ver}) is not supported. Skipping this test!");
done_testing ();
DBUG_LEAVE (0);
}
my %val;
foreach my $v ( values %Date::Manip::Lang::index::Lang ) {
$val{$v} = 1;
}
@global_modules = sort keys %val;
if ( $#global_modules == -1 ) {
dbug_ok (1, "No Date::Manip::Lang::<lang> modules are installed. Skipping this test!");
done_testing ();
DBUG_LEAVE (0);
}
# Now load all those modules ...
foreach my $l ( @global_modules ) {
my $module = "Date::Manip::Lang::${l}";
use_ok ($module);
}
DBUG_VOID_RETURN ();
}
END {
DBUG_ENTER_FUNC ();
# Don't do any tests in the END block ...
t/76-check_all_languages2.t view on Meta::CPAN
}
# ====================================================================
sub load_all_language_data
{
DBUG_ENTER_FUNC (@_);
my %lang_data;
foreach my $mod ( @global_modules ) {
my $module = "Date::Manip::Lang::${mod}";
my ( $lang_wide, $lang_utf8 ) = ( 0, 0 );
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;
( run in 1.460 second using v1.01-cache-2.11-cpan-49f99fa48dc )