Advanced-Config
view release on metacpan or search on metacpan
lib/Advanced/Config/Date.pm view on Meta::CPAN
# --------------------------------------------------------------
sub _find_month_in_string
{
DBUG_ENTER_FUNC (@_);
my $date_str = shift;
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;
lib/Advanced/Config/Date.pm view on Meta::CPAN
sub _find_day_of_month_in_string
{
DBUG_ENTER_FUNC (@_);
my $date_str = shift;
my $skip_period = shift; # Skip entries ending in '.' like 17.!
my $month_str = shift; # Will be undef if skip_period is true!
my $day;
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 );
lib/Advanced/Config/Options.pm view on Meta::CPAN
In most cases the defaults should do nicely for you. But when you share config
files between applications, you may not have any control over the config file's
format. This may also apply if your organization requires a specific format
for its config files.
So this section deals with the options you can use to override how it parses and
interprets the config file when it is loaded into memory. None of these options
below allows leading or trailing spaces in the option's value. And if any are
found, they will be automatically trimmed off before their value is used.
Internal spaces are OK when non-numeric values are expected. In most cases
values with a length of B<0> or B<undef> are not allowed.
Just be aware that some combinations of I<Read> options may result in this
module being unable to parse the config file. If you encounter such a
combination open a CPAN ticket and I'll see what I can do about it. But some
combinations may just be too ambiguous to handle.
Also note that some I<Read> options have B<left> and B<right> variants. These
options are used in pairs and both must anchor the target in order for the rule
to be applied to it. These start/end anchors can be set to the same string or
different strings. Your choice.
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# Is the line info sensitive & should it be hidden/masked in fish ???
my $hide = 0;
if ( $hide_section{$section} ||
$cmt =~ m/(^|${lbl_sep})${encrypt_str}(${lbl_sep}|$)/ ||
$cmt =~ m/(^|${lbl_sep})${hide_str}(${lbl_sep}|$)/ ||
should_we_hide_sensitive_data ( $tag, 1 ) ) {
$hide = 1 unless ( $opts->{dbug_test_use_case_hide_override} );
}
if ( $hide ) {
# Some random length so we can't assume the value from the mask used!
my $mask = "*"x8;
if ( $value eq "" ) {
if ( is_assign_spaces ( $opts ) ) {
$line =~ s/^(\s*\S+\s+)/${1}${mask} /;
} else {
$line =~ s/(\s*${assign_str})\s*/${1} ${mask} /;
}
} else {
my $hide_value = convert_to_regexp_string ( $value, 1 );
if ( is_assign_spaces ( $opts ) ) {
lib/Advanced/Config/Reader.pm view on Meta::CPAN
if ( $tv_pair_flag && $value =~ m/(\s*${comment}\s*)(.*)$/ ) {
$cmts = $2;
my $cmt2 = convert_to_regexp_string ($1 . $cmts);
$line =~ s/${cmt2}$//; # Remove the comment from the line.
DBUG_PRINT ("LINE", "Last ditch effort to remove the comment from the value ...");
return DBUG_RETURN ( $tv_pair_flag, $line, $cmts, "", "");
}
$cmts = $line;
$line =~ s/\s*${comment}.*$//; # Strip off any comments ....
$cmts = substr ( $cmts, length ($line) ); # Grab the comments ...
$cmts =~ s/^\s*${comment}\s*//; # Remove comment symbol ...
DBUG_PRINT ("LINE", "Last ditch effort to remove the comment from the line ...");
DBUG_RETURN ( $tv_pair_flag, $line, $cmts, "", "");
}
# ==============================================================
=item ($v[, $h]) = expand_variables ( $config, $string[, $file[, $sensitive[, trim]]] )
lib/Advanced/Config/Reader.pm view on Meta::CPAN
}
$output =~ s/${regExpVal}//; # Strip off the matching values ...
$output = reverse ($output) if ( $reverse_msg ne "" );
DBUG_PRINT ("MOD",
"The modifier (%s) converted \"%s\" to \"%s\".%s\nTo trim the value to: %s",
$mod_opt, $mod_val, $regExpVal, $reverse_msg, $output);
} elsif ( $mod_opt eq "LENGTH" ) {
$output = length ( $alt_val );
DBUG_PRINT ("MOD", "Setting the length of variable \${#%s} to: %d.",
$mod_tag, $output);
} elsif ( $mod_opt eq "LIST" ) {
my @lst = $cfg->_find_variables ( $mod_val );
$output = join (" ", @lst);
DBUG_PRINT ("MOD", "Getting all varriables starting with %s", $mod_val);
} elsif ( $mod_opt eq "!" ) {
($output, $mask) = $cfg->lookup_one_variable ( $alt_val );
if ( $mask == -1 ) {
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$output =~ s/${ptrn}/${val}/g;
DBUG_PRINT ("MOD", "Global replacement in %s", $alt_val);
} elsif ( $mod_opt eq "/" ) {
my ($ptrn, $val) = split ("/", $mod_val);
$output = $alt_val;
$output =~ s/${ptrn}/${val}/;
DBUG_PRINT ("MOD", "1st replacement in %s", $alt_val);
} elsif ( $mod_opt eq ":" ) {
my ($offset, $length) = split (":", $mod_val);
if ( defined $length && $length ne "" ) {
$output = substr ( $alt_val, $offset, $length);
} else {
$output = substr ( $alt_val, $offset);
}
DBUG_PRINT ("MOD", "Substring (%s)", $output);
# The 6 case manipulation modifiers ...
} elsif ( $mod_opt eq "^^" ) {
$output = uc ($alt_val);
DBUG_PRINT ("MOD", "Upshift string (%s)", $output);
} elsif ( $mod_opt eq ",," ) {
lib/Advanced/Config/Reader.pm view on Meta::CPAN
($sub_tag, $sub_opr, $sub_val) = ($1, $2, $3);
$sub_val = "Parameter null or not set." if ( $sub_val eq "" );
# Rule: ##, %%, #, or %
} elsif ( $tag =~ m/^(${not}+)(##)(.+)$/ ||
$tag =~ m/^(${not}+)(%%)(.+)$/ ||
$tag =~ m/^(${not}+)(#)(.+)$/ ||
$tag =~ m/^(${not}+)(%)(.+)$/ ) {
($sub_tag, $sub_opr, $sub_val) = ($1, $2, $3);
# Rule: Get length of variable's value ...
} elsif ( $tag =~ m/^#(.+)$/ ) {
# Using LENGTH for ${#var} opt since "#" is already used above!
($sub_tag, $sub_opr, $sub_val) = ($1, "LENGTH", "");
$sub_tag =~ s/^\s+//;
# Rule: ${!var*} & ${!var@} ...
} 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+//;
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# ---------------------------------------------------------------
# Call the custom encryption call back method ...
# ---------------------------------------------------------------
if ( exists $rOpts->{encrypt_cb} && ref ( $rOpts->{encrypt_cb} ) eq "CODE" ) {
$value = $rOpts->{encrypt_cb}->( 1, $tag, $value, $alias, $rOpts->{encrypt_cb_opts} );
}
# ---------------------------------------------------------------
# Pad the value out to a minimum lenth ...
# ---------------------------------------------------------------
my $len1 = length ($value);
my $len2 = length ($tag);
my $len = ($len1 > $len2) ? $len1 : $len2;
my $len3 = length ($rOpts->{pass_phrase});
$len = ( $len > $len3) ? $len : $len3;
# Enforce a minimum length for the value ... (will always end in spaces)
$len = ($len < 12) ? 15 : ($len + 3);
$value = sprintf ("%-*s", $len, $value . "|");
# ---------------------------------------------------------------
# Encrypt the value via this module ...
# ---------------------------------------------------------------
$value = _encrypt ( $value, $rOpts->{pass_phrase}, $tag, $alias, $rOpts->{encrypt_by_user} );
DBUG_RETURN ( $value );
}
lib/Advanced/Config/Reader.pm view on Meta::CPAN
{
DBUG_MASK_NEXT_FUNC_CALL (0, 1); # Masks ${val} & ${pass} ...
DBUG_ENTER_FUNC ( @_ );
my $val = shift; # Sensitive ... if not already encrypted.
my $pass = shift; # Very, very sensitive ... always clear text.
my $tag = shift;
my $alias = shift;
my $usr_flg = shift; # 0 - no, 1 - yes
DBUG_MASK (0);
# Verify lengths are different to prevent repeatable patterns.
if ( length ( $tag ) == length ( $alias ) ) {
$tag .= "|"; # Make different lengths
}
my $len = length ( $val );
my $key1 = _make_key ( $tag, $len );
my $key2 = _make_key ( $alias, $len );
my $res = $key1 ^ $key2;
if ( $pass ) {
my $key3 = _make_key ( $pass, $len );
$res = $res ^ $key3;
}
lib/Advanced/Config/Reader.pm view on Meta::CPAN
$phrase = $target . pack ("C*", reverse (unpack ("C*", $target)));
} else {
# Unicode strings (utf8 / Wide Chars)
# Strip off the upper byte from each unicode char ...
my @ans = map { $_ % 0x100 } unpack ("U*", $target);
$phrase = pack ("C*", @ans) . pack ("C*", reverse (@ans));
}
my $key = $phrase;
while ( length ( $key ) < $len ) {
$key .= $phrase;
}
$key = substr ( $key, 0, $len ); # Truncate it to fit ...
DBUG_RETURN ( $key ); # Always an ascii string ...
}
# ==============================================================
t/40-validate-modifiers.t view on Meta::CPAN
my $lst = join (" ", sort keys %l);
my %values = ( "msg" => $Msg,
"a" => $aMsg,
"b" => $bMsg,
"c" => $cMsg,
"d" => $dMsg,
"a2" => $a2Msg,
"c2" => $c2Msg,
"e2" => $e2Msg,
"len" => length ($Msg),
"cd" => "call die",
"abcd" => "",
"die2" => $Msg,
"die3" => "",
"die4" => $Msg,
"def0" => "The unknown soldier",
"def1" => "The unknown soldier.",
"def2" => $dMsg,
( run in 0.346 second using v1.01-cache-2.11-cpan-65fba6d93b7 )