Advanced-Config
view release on metacpan or search on metacpan
my $by2 = __PACKAGE__ . "::_load_config_with_new_date_opts";
if ( $c eq $by ) {
# Manually merging in another config file.
push (@{$self->{CONTROL}->{MERGE}}, $filename);
} elsif ( $c eq $by2 ) {
# Sourcing in a file says to remove these old decryption opts.
delete $read_opts->{alias} unless ( $new_opts->{alias} );
delete $read_opts->{pass_phrase} unless ( $new_opts->{pass_phrase} );
delete $read_opts->{encrypt_by_user} unless ( $new_opts->{encrypt_by_user} );
} else {
# 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 ...
# Dynamically correct based on type of string ...
$read_opts->{use_utf8} = ( $string =~ m/[^\x00-\xff]/ ) ? 1 : 0;
# Behaves diferently based on who calls us ...
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;
if ( $msg ) {
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, 0 ) );
}
my $status = encrypt_config_file_details ($file, $scratch, $rOpts);
# Some type of error ... or nothing was encrypted ...
if ( $status == 0 || $status == -1 ) {
unlink ( $scratch );
# Replacing the original file ...
} elsif ( ! $newFile ) {
unlink ( $file );
move ( $scratch, $file );
}
DBUG_RETURN ( $status );
}
#######################################
if ( $msg ) {
return DBUG_RETURN ( croak_helper ( $rOpts, $msg, undef ) );
}
my $status = decrypt_config_file_details ($file, $scratch, $rOpts);
# Some type of error ... or nothing was decrypted ...
if ( $status == 0 || $status == -1 ) {
unlink ( $scratch );
# Replacing the original file ...
} elsif ( ! $newFile ) {
unlink ( $file );
move ( $scratch, $file );
}
DBUG_RETURN ( $status );
}
#######################################
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:
a) place your modifications in the Public Domain or otherwise make them
lib/Advanced/Config/Examples.pm view on Meta::CPAN
doing the sourcing, not the current directory your program is running in.
This way the writer of the config file, not the programmer, controls which
config file gets sourced in. Of course the config file writer can give control
back to the programmer by using variables as part of the name of the config
file being sourced in.
If recursion is detected, this module silently refuses to reload the problem
config file and breaks the recursion. But you have the option of treating it
as a fatal error instead. Recursion is detected even if you source in a
symbolic link back to the original file.
It is always a fatal error if the requested config file doesn't exist!
=head1 CONTROLLING THE PARSING OF YOUR CONFIG FILES
See I<The Read Options> section of L<Advanced::Config::Options> for what options
are available for customizing how your configuration files gets parsed.
While I<The Get Options> section covers options for looking up the value for
a given tag generated.
lib/Advanced/Config/Examples.pm view on Meta::CPAN
# The balanced quotes will automatically be removed from the value ...
tag2="efg" # See we put surrounding quotes arround the value.
tag3 = 'l m n' # The alternate quotes.
tag4 = p q r # See quotes are completely optional.
tag5 = ${tag1} # Performs variable substitution, same as: tag5 = "abc".
tag1 = xyz # See I've overriden tag1's original value to "xyz".
TAG1 = 123 # tag1 is still xyz, tags are case sensitive.
To load it into memory do:
my $cfg = Advanced::config->new ("simple.cfg")->load_config();
=item A SLIGHTLY MORE COMPLEX CONFIG FILE. (complex.cfg)
# Merge in this config file. Looks in the same directory as
# this config file is in. Not the program's current directory.
lib/Advanced/Config/Examples.pm view on Meta::CPAN
=item SOURCING IN FILES WITH SECTIONS (src_sect.cfg)
By default, when sourcing in another config file it's default section is
also called "B<main>". This is true even when you are sourcing in a file
inside a named section block. That name isn't inherited by default.
And if that config file also uses sections, those section names are preserved.
But sometimes you'd like to source in a sub-file as if any tag appearing
outside a section was defined in the original file's current section. In
that case follow the file name with the appropriate label. Which by default
is B<DEFAULT>.
. simple.cfg # All variables appear in the main section.
[ section 1 ]
. simple.cfg # All varibles appear in the main section as well.
[ section 2 ]
. simple.cfg # DEFAULT - all varibles from this config file will apear as members of "section 2".
lib/Advanced/Config/Options.pm view on Meta::CPAN
remaining options are. See option B<source_cb> if you need to set them in this
caes.
=over 4
B<alias> - Defaults to the empty string. (Meaning no alias provided.) This
option is used to override using the file's I<basename> as one of the
encrytion/decryption keys with the I<basename> of the value you provide here.
If you encrypt a file with no I<alias>, and then rename the config file, you
must set the I<alias> to the original filename to be able to decrypt anything.
If you encrypt a file with an I<alias>, you must use the same I<alias> to
decrypt things again.
If your config file is a symbolic link to another name, it will auto set this
option for you using the file's real name as the alias if you don't override
it by setting the alias yourself.
B<pass_phrase> - Defaults to the empty string. If you used a pass phrase to
encrypt the value, then you need to use the same pass phrase again when
decrypting each tag's value.
lib/Advanced/Config/Options.pm view on Meta::CPAN
# -------------------------------------------------------------------
# Do we need to convert to upper or lower case?
if ( $get_opts->{vcase} > 0 ) {
$v = uc ( $v );
} elsif ( $get_opts->{vcase} < 0 ) {
$v = lc ( $v );
}
# -------------------------------------------------------------------
# Convert into a boolean value ??? (you never see the original value)
if ( $get_opts->{auto_true} ) {
$result{MASK_IN_FISH} = 0; # Boolean values are never sensitive!
my $numeric = 0;
if ( $old =~ m/^[-+]?\d+([.]\d*)?$/ ||
$old =~ m/^[-+]?[.]\d+$/ ) {
$numeric = 1;
$old += 0; # Convert string to a number ...
}
lib/Advanced/Config/Reader.pm view on Meta::CPAN
config file as it's read in. It's main purpose is to strip off leading and
trailing spaces and any comments it might find on the input line. It also
tells if the I<$input> contains a tag/value pair.
It returns 5 values: ($tv_flg, $line, $comment, $lQuote, $rQuote)
B<$tv_flg> - True if I<$line> contains a tag/value pair in it, else false.
B<$line> - The trimmed I<$input> line minus any comments.
B<$comment> - The comment stripped out of the original input line minus the
leading comment symbol(s).
B<$lQuote> & B<rQuote> - Only set if I<$tv_flg> is true and I<$lQuote> was
the 1st char of the value and I<$rQuote> was the last char of the tag's value.
If the value wasn't surrounded by balanced quotes, both return values will be
the empty string B<"">.
If these quotes are returned, it expects the caller to remove them from the
tag's value. The returned values for these quote chars are suitable for use as
is in a RegExpr. The caller must do this in order to preserve potential
lib/Advanced/Config/Reader.pm view on Meta::CPAN
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
# NOTE1: Fish has already been paused if $tag is sensitive. Since this method
# has no idea if the current tag is sensitive or not.
# NOTE2: But still need to mask the return value if referencing sensitive data
# in case the original $tag wasn't sensitive. So in most cases it will
# return not-sensitive even if fish has already been paused!
#
# NOTE3: If sensitive/mask is -1, it's sensitive and not decrypted. In this
# case the returned value is the tag's name, not it's value!
sub apply_modifier
{
DBUG_ENTER_FUNC ( @_ );
my $cfg = shift;
my $value = shift; # The value for ${mod_tag} ...
lib/Advanced/Config/Reader.pm view on Meta::CPAN
Other modifier rules may be added upon request.
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.
#
lib/Advanced/Config/Reader.pm view on Meta::CPAN
DBUG_RETURN ( $value );
}
# ==============================================================
=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;
t/20-validate_encrypt_decrypt.t view on Meta::CPAN
my @sect = $dcfg->find_sections ();
my $cnt = keys %{$data};
my $dcnt = @sect;
dbug_ok (1, "-"x30);
dbug_is ($cnt, $dcnt, "The ${lbl} config file has the right number of sections.");
$cnt = 0;
foreach my $s ( @sect ) {
unless ( exists $data->{$s} ) {
dbug_ok (0, "Section '$s' exists in the original config file.");
next;
}
my @tag_list = $dcfg->get_section ($s)->find_tags ();
my $tcnt = @tag_list;
ok ( $tcnt == $data->{$s}->{CNT}, "Section '$s' in the ${lbl} cfg file has the right number of tags ($tcnt)" );
foreach my $t ( @tag_list ) {
my $stag = $cfg->get_section ($s)->get_value ($t);
my $dtag = $dcfg->get_section ($s)->get_value ($t);
t/30-alt_symbols_cfg.t view on Meta::CPAN
$ropts = print_opts_hash ( "Read Options for: $f", $ropts );
$dopts = print_opts_hash ( "Date Options for: $f", $dopts );
DBUG_RETURN ( $ropts, $dopts );
}
# ====================================================================
sub compare_config_files
{
DBUG_ENTER_FUNC (@_);
my $src_cfg = shift; # The original validated config file to compare against.
my $dst_cfg = shift; # The new config file to validate.
my $cmts = shift; # The tags with comment chars in their values!
my $sect = shift; # The section to change to.
my ( $cnt1, $cnt2 );
my @sections = $dst_cfg->find_sections ();
$cnt1 = @sections;
dbug_cmp_ok ($cnt1, '>', 0, "The config file has ${cnt1} section(s)!");
t/55-validate-strings.t view on Meta::CPAN
test_results ($cfg, $miss);
test_results ($sCfg, $miss);
test_results ($bCfg, $miss);
# ----------------------------------------------------------
# Now lets test encrypting then decrypting a string ...
# ----------------------------------------------------------
dbug_ok ( 1, "-"x50 );
$sect = "section";
my $original = "abc = 'Help me!' # ENCRYPT you\n"
. "xyz = 'No way!' # ENCRYPT me\n"
. "[${sect}]\n"
. "lmn = 'no one' # ENCRYPT us\n"
. "no = never encrypt!\n"
;
my $alias = "STRING-IS-A-GO-go!";
# Defere the dbug_ok() calls until after they've been loaded!
my $str1 = $cfg->encrypt_string ($original, $alias);
my $str2 = $cfg->decrypt_string ($str1, $alias);
# ----------------------------------------------------------
# Now some more detailed comparisons of the results ...
# ----------------------------------------------------------
my $xCfg1 = init_config ( $original );
my $xCfg2 = init_config ( $str1, $alias ); # Decryption works ...
my $xCfg3 = init_config ( $str1 ); # Decryption fails ...
my $xCfg4 = init_config ( $str2 );
dbug_ok ((defined $str1 && $str1 ne $original), "Encrypting a string looks good!");
dbug_ok ((defined $str2 && $str2 ne $str1), "Decrypting a string looks good!");
my $sxCfg1 = $xCfg1->get_section ($sect);
my $sxCfg2 = $xCfg2->get_section ($sect);
my $sxCfg3 = $xCfg3->get_section ($sect);
my $sxCfg4 = $xCfg4->get_section ($sect);
dbug_ok ( defined $sxCfg1, "Section exists" );
dbug_ok ( defined $sxCfg2, "Section exists" );
dbug_ok ( defined $sxCfg3, "Section exists" );
dbug_ok ( defined $sxCfg4, "Section exists" );
# This is a lousy test ... Remove & update $original when detailed test available!
dbug_cmp_ok ( $str2, 'eq', $original, "Encrypting then decrypting produced the correct string!" );
dbug_ok ( test_obj ($xCfg1, $xCfg2, [ "abc", "xyz" ], [] ), "Compares main OK" );
dbug_ok ( test_obj ($sxCfg1, $sxCfg2, [ "lmn", "no" ], [] ), "Compares section OK" );
dbug_ok ( test_obj ($xCfg1, $xCfg3, [], [ "abc", "xyz" ] ), "Decrypts main Failed as expected" );
dbug_ok ( test_obj ($sxCfg1, $sxCfg3, [ "no" ], [ "lmn" ] ), "Decrypts section Failed as expected" );
dbug_ok ( test_obj ($xCfg1, $xCfg4, [ "abc", "xyz" ], [] ), "Decrypts main OK" );
dbug_ok ( test_obj ($sxCfg1, $sxCfg4, [ "lmn", "no" ], [] ), "Decrypts section OK" );
t/75-check_all_languages.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;
# ---------------------------------------------------------------------
# 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;
t/76-check_all_languages2.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;
# ---------------------------------------------------------------------
# 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;
t/config/30-alt_symbol_control.cfg view on Meta::CPAN
[ 30-alt_symbols_70 merge multiple files.cfg ]
source_cb = "main::ALTER_SOURCE_CALLBACK_OPTIONS"
croak = 2
section_test_01 = section_03
section_test_02 = section_01
section_test_03 = section_02
# ---------------------------------------------------------------------
# Simulates test # 70 using calls to merge_config() instead of
# directly sourcing in the extra file from the original config file.
[ 30-alt_symbols_71_empty.cfg ]
croak = 2
section_test_01 = section_03
section_test_02 = section_01
section_test_03 = section_02
# ---------------------------------------------------------------------
# Like test # 71, except that it calls merge_config() multiple times
( run in 0.311 second using v1.01-cache-2.11-cpan-1c8d708658b )