Advanced-Config
view release on metacpan or search on metacpan
These methods allow you to access the data loaded into each B<tag> in list mode.
Splitting the B<tag>'s data up into arrays and hashes. Otherwise these
functions behave similarly to the one's above.
Each function asks for a I<pattern> used to split the B<tag>'s value into an
array of values. If the pattern is B<undef> it will use the default
I<split_pattern> specified during he call to F<new()>. Otherwise it can be
either a string or a RegEx. See Perl's I<split> function for more details.
After the value has been split, it will perform any requested validation and
most functions will return B<undef> if even one element in the list fails it's
edits. It was added as its own arguement, instad of just relying on the
override option hash, since this option is probably the one that gets overidden
most often.
They also support the same I<inherit> and I<required> options described for the
scalar functions as well.
They also all allow F<%override_get_opts>, passed by value or by reference, as
an optional argument that overrides the default options provided in the call
to F<new()>. If you should use both option I<split_pattern> and the I<pattern>
argument, the I<pattern> argument takes precedence. So leave this optional
lib/Advanced/Config/Date.pm view on Meta::CPAN
# 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 ();
my %last_language_edit_flags;
# Variants for the month names & days of month ...
# We hard code the initialization in case neither
# language module is installed locally.
my %Months;
my %Days;
BEGIN {
# Variants for the month names ...
%Months = (
lib/Advanced/Config/Date.pm view on Meta::CPAN
'thirty-one' => -31,
);
my $date_manip_installed_flag = keys %date_manip_installed_languages;
my $date_language_installed_flag = keys %date_language_installed_languages;
# Tells what to do about the negative values in the hashes ...
my $flip = $date_manip_installed_flag || (! $date_language_installed_flag);
$last_language_edit_flags{language} = "English";
$last_language_edit_flags{month_period} = 0;;
$last_language_edit_flags{dsuf_period} = 0;
$last_language_edit_flags{dow_period} = 0;;
foreach ( keys %Months ) {
next if ( $Months{$_} > 0 );
if ( $flip ) {
$Months{$_} = abs ($Months{$_});
} else {
delete $Months{$_};
}
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
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;
if ( (! defined $lang) || lc($lang) eq lc($last_language_edit_flags{language}) ) {
return DBUG_RETURN ( $last_language_edit_flags{language} );
}
my ($manip_ref, $lang_ref) = _select_language ($lang, $warn_ok, $allow_wide);
unless ( $lang_ref || $manip_ref ) {
return DBUG_RETURN ( $last_language_edit_flags{language} );
}
my ($month_ref, $day_ref, $issue1_ref);
if ( $manip_ref ) {
my $old = $manip_ref->{Language};
($month_ref, $day_ref, $issue1_ref) =
_swap_manip_language_common ($manip_ref, $warn_ok, $allow_wide );
$lang = $manip_ref->{Language};
if ( $old ne $lang && ! $lang_ref ) {
lib/Advanced/Config/Date.pm view on Meta::CPAN
my ($MoY_ref, $MoYs_ref, $Dsuf_ref, $issue2_ref);
if ( $lang_ref ) {
my ($unused_DoW_ref, $unused_DoWs_ref);
($MoY_ref, $MoYs_ref, $Dsuf_ref, $unused_DoW_ref, $unused_DoWs_ref, $issue2_ref) =
_swap_lang_common ( $lang_ref, $warn_ok, $allow_wide );
$lang = $lang_ref->{Language};
}
unless ( $MoY_ref || $month_ref ) {
return DBUG_RETURN ( $last_language_edit_flags{language} );
}
DBUG_PRINT ("SWAP", "Swapping from '%s' to '%s'.",
$last_language_edit_flags{language}, $lang);
# ---------------------------------------------------------
foreach my $k ( keys %last_language_edit_flags ) {
$last_language_edit_flags{$k} = $issue1_ref->{$k} || $issue2_ref->{$k} || 0;
}
$last_language_edit_flags{language} = $lang;
# ---------------------------------------------------------
# Bug Alert: For some languges the following isn't true!
# lc(MoY) != lc(uc(lc(MoY)))
# So we have multiple lower case letters mapping to the
# same upper case letters#.
# ---------------------------------------------------------
# This happens for 3 languages for Date::Language.
# Chinese_GB, Greek & Russian_cp1251
# And one language for Date::Manip
lib/Advanced/Config/Date.pm view on Meta::CPAN
$Days{lc (uc (lc ($key)))} = $day; # Bug fix, but usually same.
}
}
# ---------------------------------------------------------
# Report the results ...
DBUG_PRINT ( "LANGUAGE", "%s\n%s\n%s",
join (", ", sort { $Months{$a} <=> $Months{$b} || $a cmp $b } keys %Months),
join (", ", sort { my ($x,$y) = ($a,$b); $x=~s/\D+//g; $y=~s/\D+//g; $x=0 if ($x eq ""); $y=0 if ($y eq ""); ($x<=>$y || $a cmp $b) } keys %Days),
join (", ", %last_language_edit_flags) );
DBUG_RETURN ( $lang );
}
# ==============================================================
=item $date = parse_date ( $date_str, $order[, $allow_dl[, $enable_2_digit_years]] );
Passed a date in some unknown format, it does it's best to parse it and return
lib/Advanced/Config/Date.pm view on Meta::CPAN
my $use_date_language_module = shift || 0;
my $allow_2_digit_years = shift || 0;
# The Month name pattern, ... [a-zA-Z] doesn't work for other languages.
my $name = "[^-\$\\s\\d.,|\\[\\]\\\\/{}()]";
# The Day of Month pattern ... (when not all digits are expected)
my $dom = "\\d{0,2}${name}*";
# Remove the requesed character from the month pattern ...
$name =~ s/\\s//g if ( $last_language_edit_flags{month_spaces} );
$name =~ s/[.]//g if ( $last_language_edit_flags{month_period} );
$name =~ s/-//g if ( $last_language_edit_flags{month_hyphin} );
$name .= '+'; # Terminate the name pattern.
# Remove the requesed character from the day of month pattern ...
$dom =~ s/\\s//g if ( $last_language_edit_flags{dsuf_spaces} );
$dom =~ s/[.]//g if ( $last_language_edit_flags{dsuf_period} );
$dom =~ s/-//g if ( $last_language_edit_flags{dsuf_hyphin} );
my ( $year, $month, $day );
my ( $s1, $s2 ) = ( "", "" );
my $fmt = "n/a";
# The 7 separators to cycle through to parse things correctly ...
my @seps = ( "-", "/", "[.]", ",", "\\s+", '\\\\', ":" );
# -------------------------------------------------------
# Let's start with the 4-digit year formats ...
lib/Advanced/Config/Date.pm view on Meta::CPAN
# Keep after my checks so that things are consistent when this module
# isn't installed. (No way to disable 2-digit year format here.)
# --------------------------------------------------------------------
if ( $use_date_language_module && ! defined $year ) {
unless ( _date_language_installed () ) {
DBUG_PRINT ("INFO", "Using Date::Language::str2time was requested, but it's not installed!");
} else {
DBUG_PRINT ("INFO", "Using Date::Language::str2time to attempt the parse!");
eval {
my $dl = Date::Language->new ( $last_language_edit_flags{language} );
my $t = $dl->str2time ( $in_date );
if ( defined $t ) {
($year, $month, $day) = (localtime ($t))[5,4,3];
$year += 1900;
$month += 1;
}
};
}
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
# --------------------------------------------------------------------
# If my parsing didn't work try using Date::Language if it's installed.
# Keep after my checks so that things are consistent when this module
# isn't installed. (No way to disable 2-digit year format here.)
# --------------------------------------------------------------------
if ( $use_date_language_module && (! $out_str) &&
_date_language_installed () ) {
DBUG_PRINT ("INFO", "Using Date::Language::str2time to attempt parsing!");
eval {
my $dl = Date::Language->new ( $last_language_edit_flags{language} );
my $t = $dl->str2time ( $in_date );
if ( defined $t ) {
my ($year, $month, $day) = (localtime ($t))[5,4,3];
$year += 1900;
$month += 1;
$out_str = _check_if_good_date ($in_date, $year, $month, $day);
}
};
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
my $month;
my $digits = 0;
my @lst = sort { length($b) <=> length($a) || $a cmp $b } keys %Months;
foreach my $m ( @lst ) {
# Ignore numeric keys, can't get the correct one from string ...
next if ( $m =~ m/^\d+$/ );
my $flag1 = ( $last_language_edit_flags{month_period} &&
$m =~ s/[.]/\\./g );
if ( $date_str =~ m/(${m})/ ) {
$month = $1;
$month =~ s/[.]/\\./g if ( $flag1 );
last;
}
}
# Allow any number between 1 and 12 ...
lib/Advanced/Config/Date.pm view on Meta::CPAN
my $digits = 0;
my @lst = sort { length($b) <=> length($a) || $a cmp $b } keys %Days;
my $all_digits = $skip_period ? "^\\d+[.]?\$" : "^\\d+\$";
foreach my $dom ( @lst ) {
# Ignore numeric keys, can't get the correct one from string ...
next if ( $dom =~ m/${all_digits}/ );
my $flag1 = ( $last_language_edit_flags{dsuf_period} &&
$dom =~ s/[.]/\\./g );
if ( $month_str ) {
# Makes sure dom doesn't match month name ...
$month_str =~ s/[.]/\\./g;
if ( $date_str =~ m/${month_str}.*(${dom})/ ||
$date_str =~ m/(${dom}).*${month_str}/ ) {
$day = $1;
$day =~ s/[.]/\\./g if ( $flag1 );
last;
lib/Advanced/Config/Options.pm view on Meta::CPAN
The following options deal with the encryption/decryption of the contents of a
config file. Only the encryption of a tag's value is supported. And this is
triggered by the appropriate label in the comment on the same line after the
value.
Unless you use the B<encrypt_cb> option, this module isn't using true
encryption. It's more a complex obscuring of the tag's value making it very
difficult to retrieve a tag's value without using this module to examine the
config file's contents. It's main use is to prevent casual browsers of your
file system from being able to examine your config files using their favorite
editor to capture sensitive data from your config files.
By default, the I<basename> of the config file's name and the tag's name are the
keys used to encode each value in the config file. This means that each tag's
value in the config file uses a different key to obscure it. But by using just
the defaults, anyone using this module may automatically decode everything in
the config file just by writing a perl program that uses this module.
But by using the options below, you gain additional security even without using
true encryption. Since if you don't know the options used, you can't easily
decode each tag's value even by examining the code. Just be aware that using
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# ==============================================================
=item ($v[, $s]) = apply_modifier ( $config, $value, $tag, $rule, $sub_rule, $file )
This is a helper method to F<expand_variables>. Not for public use.
This function takes the rule specified by I<$rule> and applies it against
the I<$value> with assistance from the I<$sub_rule>.
It returns the edited I<value> and whether applying the modifier made it
I<sensitive>. (-1 means it's an encrypted value. -2 means it's the variable
name that resolves to an encrypted value. 0 - Non-senitive, 1 - Sensitive.)
See L<https://web.archive.org/web/20200309072646/https://wiki.bash-hackers.org/syntax/pe>
for information on how this can work. This module supports most of the
parameter expansions listed there except for those dealing with arrays. Other
modifier rules may be added upon request.
=cut
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 )
( run in 0.401 second using v1.01-cache-2.11-cpan-de7293f3b23 )