Advanced-Config
view release on metacpan or search on metacpan
$begin_special_vars{flavor} = os_type (); # Windows, Unix, etc...
# ---------------------------------------------
# Get the Parent PID if available ... (PPID)
# ---------------------------------------------
eval {
$begin_special_vars{PPID} = getppid ();
};
if ( $@ ) {
DBUG_PRINT ("INFO", "Cheating to get the PPID. It may be wrong!");
# We can't easily get the parent process id for Windows.
# So we're going to cheat a bit. We'll ask if any parent
# or grandparent process used this module before and call it
# the parent process!
$secret_tag = "_ADVANCED_CONFIG_PPID_";
if ( $ENV{$secret_tag} ) {
$begin_special_vars{PPID} = $ENV{$secret_tag};
} else {
$begin_special_vars{PPID} = -1; # Can't figure out the PPID.
}
$ENV{$secret_tag} = $$;
}
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.
6) Supports encrypting/decrypting values in your config files to keep
the contents of your config files safe from prying eyes but usable in
your code.
7) Supports the overriding of the default operators used. Such as using
different comment indicators or other special symbols interpreted when
loading the config file into memory.
8) Detecting if a config file has been updated since your program first
loaded it for dynamic refreshes for long running processes.
9) Custom accessor functions (get_*), allowing you to do basic validation
that each tag contains the expected data type.
10) And many, many more features.
full_developer_test.pl.src view on Meta::CPAN
}
print "Found: $cmd\n";
return ($cmd);
}
# Tries to find out the proper 'prove' program to use for your platform ...
sub which_prove
{
my $process = shift;
my $cmd;
print "\nSearching for the correct 'prove' variant to use ...\n\n";
foreach my $prove ( "prove" ) {
$cmd = which ( $prove );
last if ( defined $cmd );
}
unless ( defined $cmd ) {
die ("Can't locate a 'prove' program to run 'prove -bv ${process}' with!\n");
}
print "Found: $cmd\n";
return ($cmd);
}
# A simple version of which() so I don't have to depend on an external module.
sub which
{
lib/Advanced/Config/Examples.pm view on Meta::CPAN
)->load_config();
=item ENCRYPTING/DECRYPTING CONFIG FILES
Sometimes you need to protect sensitive information inside your config files.
Such as the user names and passwords that your application requires to run.
This module allows this at the individual tag/value pair level. Not at the
file level!
The 1st example shows tags whose values are pending the encryption process.
While the 2nd example shows what happens after it's been encrypted. You can
have config files that have both pending and encrypted tags in it. As well
as tags whose values are never encrypted. It is controlled by having the
appropriate label in the comment after the tag/value pair.
# Waiting to encrypt these values ...
my_username_1 = "anonymous" # ENCRYPT
my_password_1 = "This is too much fun!" # ENCRYPT me ...
# They've already been encypted!
my_username_2 = '4aka54D3eZ4aea5' # DECRYPT
my_password_2 = '^M^Mn1\pmeaq>n\q?Z[x537z3A' # DECRYPT me ...
# This value will never be encrytped/decrypted ...
dummy = "Just some strange value that is always in clear text."
The encrypted value is automatically decrypted for you when the config file
is loaded into memory. So it's already in clear text when C<get_value()> is
called. See L<Advanced::Config::Options> for more details on the options
used to control the encrypt/decrypt process. See C<encrypt_config_file()> in
L<Advanced::Config> for how to encrypt the contents of the config file itself.
You can use C<decrypt_config_file()> to reverse the process if needed.
=item PLUS MUCH, MUCH, MORE ...
I could go on and on with many more examples. I'll add more in the future as
I consider more significant issues to cover. In the mean time you can find
many more examples from the build under: I<t/config/*.cfg>
=back
=head1 COPYRIGHT
lib/Advanced/Config/Options.pm view on Meta::CPAN
unless the I<inherit> option was specified via I<$getOpts>.
I<$wide> tells if UTF-8 dates are allowed.
=cut
# ==============================================================
sub apply_get_rules
{
DBUG_ENTER_FUNC (@_);
my $tag = shift; # The tag we are processing ...
my $section = shift; # The name of the current section ...
my $value1 = shift; # The value hash from the current section ...
my $value2 = shift; # The value hash from the "main" section ...
my $wide_flg = shift; # Tells if langages like Greek are allowed ...
my $get_opts = shift; # The current "Get" options hash ...
# Did we find a value to process?
my $data = $value1;
if ( $get_opts->{inherit} && (! defined $data) ) {
$data = $value2;
}
unless ( defined $data ) {
return DBUG_RETURN ( croak_helper ( $get_opts,
"No such tag ($tag) in section ($section).",
undef ) );
}
lib/Advanced/Config/Options.pm view on Meta::CPAN
# ==============================================================
=item $str = convert_to_regexp_modifier ( $string )
Similar to C<convert_to_regexp_string> except that it doesn't convert
all the wild card chars.
Leaves the following RegExp wild card's unescaped!
S<(B<*>, B<?>, B<[>, and B<]>)>
Used when processing variable modifier rules.
=cut
sub convert_to_regexp_modifier
{
DBUG_ENTER_FUNC ( @_ );
my $str = shift;
# The 6 problem chars with special meaning in a RegExp ...
# Chars: . + ^ | $ \ (Skips * ?)
lib/Advanced/Config/Reader.pm view on Meta::CPAN
This method performs the reading and parsing of the given config file and puts
the results into the L<Advanced::Config> object I<$config>. This object
provides the necessary parsing rules to use.
If a line was too badly mangled to be parsed, it will be ignored and a warning
will be written to your screen.
It returns B<1> on success and B<0> on failure.
Please note that comments are just thrown away by this process and only
tag/value pairs remain afterwards. Everything else is just instructions to
the parser or how to group together these tag/value pairs.
If it sees something like: export tag = value, it will export tag's value
to the %ENV hash for you just like it does in a Unix shell script!
Additional modifiers can be found in the comments after a tag/value pair
as well.
=cut
lib/Advanced/Config/Reader.pm view on Meta::CPAN
}
# Don't know what the config file was thinking of ...
# Don't bother expanding any variables encountered.
DBUG_PRINT ("error", "<Previous line ignored. Unknown format!>");
next;
}
# ------------------------------------------------------------------
# If you get here, you know it's a tag/value pair to parse ...
# Don't forget that any comment can include processing instructions!
# ------------------------------------------------------------------
# Go to the requested section ...
$cfg = $pcfg->get_section ( $section, 1 );
my ($tag, $value, $prefix, $t2) = _split_assign ( $opts, $ln );
# Don't export individually if doing a batch export ...
# If the export option is used, invert the meaning ...
my $export_flag = 0; # Assume not exporting this tag to %ENV ...
lib/Advanced/Config/Reader.pm view on Meta::CPAN
} else {
my $hide_value = convert_to_regexp_string ( $value, 1 );
if ( is_assign_spaces ( $opts ) ) {
$line =~ s/^(\s*\S+\s+)${hide_value}/${1}${mask}/;
} else {
$line =~ s/(\s*${assign_str}\s*)${hide_value}/${1}${mask}/;
}
}
} elsif ( $cmt =~ m/(^|${lbl_sep})${decrypt_str}(${lbl_sep}|$)/ ) {
# Don't hide the line in fish, but hide it's value processing ...
$hide = 1 unless ( $opts->{dbug_test_use_case_hide_override} );
}
DBUG_PRINT ("READ", "READ LINE: %s", $line);
# Remove any balanced quotes ... (must do after hide)
$value =~ s/^${lq}(.*)${rq}$/$1/ if ( $lq );
if ( $tag =~ m/^(shft3+)$/i ) {
my $m = "You can't override special variable '${1}'."
lib/Advanced/Config/Reader.pm view on Meta::CPAN
last unless ( $has_no_cmt =~ m/${comment}/ ||
$has_no_cmt =~ m/${lvar}/ ||
$has_no_cmt =~ m/${rvar}/ ||
$line =~ m/${has_no_cmt}/ );
}
if ( $has_no_cmt eq "@"x10 ) {
warn ("May be having variable substitiution issues in parse_line()!\n");
}
# Strip out all the variables from the value ...
# Assumes processing variables from left to right ...
# Need to evaluate even if variables are disabled to parse correctly ...
my @parts = parse_for_variables ($var_line, 1, $opts);
my $cmt_found = 0;
my $count_var = 0;
my @data;
while (defined $parts[0]) {
$cmt_found = $parts[3];
push (@data, $var_line);
last if ($cmt_found);
$var_line = $parts[0] . $has_no_cmt . $parts[2];
lib/Advanced/Config/Reader.pm view on Meta::CPAN
my $output = $value;
my %encrypt_vars;
my $encrypt_cnt = 0;
my $encrypt_fmt = "_"x50 . "ENCRYPT_%02d" . "-"x50;
my ($lv, $rv) = ( convert_to_regexp_string ($opts->{variable_left}),
convert_to_regexp_string ($opts->{variable_right}) );
# While there are still variables to process ...
while ( defined $tag ) {
my ( $val, $mask );
my $do_mod_lookup = 0; # Very rarely set to true ...
# ${tag} and ${mod_tag} will never have the same value ...
# ${mod_tag} will amost always be undefinded.
# If both are defined, we'll almost always end up using ${mod_tag} as
# the real variable to expand! But we check to be sure 1st.
( $val, $mask ) = $config->lookup_one_variable ( $tag );
lib/Advanced/Config/Reader.pm view on Meta::CPAN
from B<ENCRYPT> to B<DECRYPT> in the new file.
If you are adding new B<ENCRYPT> tags to an existing config file that already
has B<DECRYPT> tags in it, you must use the same encryption related options in
I<%rOpts> as the last time. Otherwise you won't be able to decrypt all
encrypted values.
This method ignores any request to source in other config files. You must
encryt each file individually.
It writes the results of the encryption process to I<$writeFile>.
See L<Advanced::Config::Options> for some caveats about this process.
Returns: B<1> if something was encrypted. B<-1> if nothing was encrypted.
Otherwise B<0> on error.
=cut
sub encrypt_config_file_details
{
DBUG_ENTER_FUNC ( @_ );
my $file = shift;
lib/Advanced/Config/Reader.pm view on Meta::CPAN
After a tag's value has been decrypted, the label in the comment is updated
from B<DECRYPT> to B<ENCRYPT> in the config file.
For this to work, the encryption related options in I<\%rOpts> must match what
was used in the call to I<encrypt_config_file_details> or the decryption will
fail.
This method ignores any request to source in other config files. You must
decrypt each file individually.
It writes the results of the decryption process to I<$writeFile>.
See L<Advanced::Config::Options> for some caveats about this process.
Returns: B<1> if something was decrypted. B<-1> if nothing was decrypted.
Otherwise B<0> on error.
=cut
sub decrypt_config_file_details
{
DBUG_ENTER_FUNC ( @_ );
my $file = shift;
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# ==============================================================
=item $value = encrypt_value ($value, $tag, $rOpts, $file)
Takes the I<$value> and encrypts it using the other B<3> args as part of the
encryption key. To successfully decrypt it again you must pass the same B<3>
values for these args to the I<decrypt_value()> call.
See L<Advanced::Config::Options> for some caveats about this process.
=cut
sub encrypt_value
{
DBUG_MASK_NEXT_FUNC_CALL (0); # Masks ${value} ...
DBUG_ENTER_FUNC ( @_ );
my $value = shift; # In clear text ...
my $tag = shift;
my $rOpts = shift;
lib/Advanced/Config/Reader.pm view on Meta::CPAN
# ==============================================================
=item $value = decrypt_value ($value, $tag, $rOpts, $file)
Takes the I<$value> and decrypts it using the other B<3> args as part of the
decryption key. To successfully decrypt it the values for these B<3> args
must match what was passed to I<encryption_value()> when the value was
originially encrypted.
See L<Advanced::Config::Options> for some caveats about this process.
=cut
sub decrypt_value
{
DBUG_ENTER_FUNC ( @_ );
my $value = shift; # It's encrypted ...
my $tag = shift;
my $rOpts = shift;
my $file = shift;
t/20-validate_encrypt_decrypt.t view on Meta::CPAN
foreach my $t ( @tag_list ) {
$save{$t} = 1 if ( $t =~ m/^join/ );
}
}
DBUG_PRINT ("----", "%s", "-"x50);
# Validating the encrypted file ...
compare_cfg ( $cfg, $ecfg, "encrypted", \%data, 0, \%save);
compare_cfg ( $cfg, $dcfg, "decrypted", \%data, 0, \%save);
# These compares should fail the decryption process!
compare_cfg ( $cfg, $ecfg2, "no alias failure", \%data, 1, \%save);
compare_cfg ( $cfg, $fcfg, "clear failure", \%data, 1, \%save);
# unlink ($encrypt_file, $file_decrypt, $fail_file);
DBUG_VOID_RETURN ();
}
# =================================================================
t/config/30-alt_symbol_control.cfg view on Meta::CPAN
#
# ==========================================================================
#
# Please note that the test program does 3 tests per section:
# 1) After the initial load ...
# 2) After the 1st forced refresh ...
# 3) After the 2nd forced refresh ...
#
# ==========================================================================
# Keep the sections in this config file sorted. This is the order that
# the test program will process things.
# ==========================================================================
# Tells how many config files the test program is expecting to process.
number_test_files = 11
# ---------------------------------------------------------------------
# Test against itself ...
[ 10-simple.cfg ]
croak = 2 # Call die if it doesn't parse correctly.
# ---------------------------------------------------------------------
( run in 0.801 second using v1.01-cache-2.11-cpan-8d75d55dd25 )