Advanced-Config
view release on metacpan or search on metacpan
=cut
sub load_config
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $filename = shift;
my $read_opts = $_[0]; # Don't pop from the stack yet ...
$self = $self->{PARENT} || $self;
# Get the filename to read ...
if ( $filename ) {
$filename = $self->_fix_path ($filename);
} else {
$filename = $self->{CONTROL}->{filename};
}
# Get the read options ...
my $new_opts;
if ( ! defined $read_opts ) {
my %none;
$new_opts = \%none;
} else {
$read_opts = {@_} if ( ref ($read_opts) ne "HASH" );
$new_opts = $read_opts;
}
$read_opts = get_read_opts ( $read_opts, $self->{CONTROL}->{read_opts} );
unless ( $filename ) {
my $msg = "You must provide a file name to load!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
unless ( -f $filename ) {
my $msg = "No such file or it's unreadable! -- $filename";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_PRINT ("READ", "Reading a config file into memory ... %s", $filename);
unless ( -f $filename && -r _ ) {
my $msg = "Your config file name doesn't exist or isn't readable.";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# Behaves diferently based on who calls us ...
my $c = (caller(1))[3] || "";
my $by = __PACKAGE__ . "::merge_config";
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 ...
$self->{CONTROL}->{REFRESH_MODIFY_TIME}->{$filename} = (stat( $filename ))[9];
$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;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $msg = "Reading the config file had serious issues!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_RETURN ( $self );
}
#######################################
=item $cfg = $cfg->load_string ( $string[, %override_read_opts] );
This method takes the passed I<$string> and treats it's value as the contents of
a config file. Modifying the I<$string> afterwards will not affect things. You
can use this as an alternative to F<load_config>.
Each time you call this method, it wipes the contents of the object and starts
you from a clean slate again. Making it safe to call multiple times if needed.
The I<%override_read_opts> options apply just to the current call to
I<load_string> and will be forgotten afterwards. If you want these options
to persist between calls, set the option via the call to B<new()>. This
argument can be passed either by value or by reference. Either way will work.
See L<Advanced::Config::Options> for more details.
If you plan on decrypting any values in the string, you must use the B<alias>
option in order for them to be successfully decrypted.
On success, it returns a reference to itself so that it can be initialized
separately or as a single unit.
=cut
sub load_string
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $string = shift; # The string to treat as a config file's contents.
my $read_opts = $_[0]; # Don't pop from the stack yet ...
$self = $self->{PARENT} || $self;
# Get the read options ...
$read_opts = {@_} if ( ref ($read_opts) ne "HASH" );
$read_opts = get_read_opts ( $read_opts, $self->{CONTROL}->{read_opts} );
unless ( $string ) {
my $msg = "You must provide a string to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# The filename is a reference to the string passed to this method!
my $filename = \$string;
# If there's no alias provided, use a default value for it ...
# There is no filename to use for decryption purposes without it.
$read_opts->{alias} = "STRING" unless ( $read_opts->{alias} );
# 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;
# Temp override of the default read options ...
local $self->{CONTROL}->{read_opts} = $read_opts;
unless ( read_config ( $filename, $self ) ) {
my $msg = "Reading the config file had serious issues!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
DBUG_RETURN ( $self );
}
#######################################
# No POD on purpose ...
# For use by Advanced::Config::Reader only.
# Purpose is to allow source_file() a way to modify the date options.
sub _load_config_with_new_date_opts
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $filename = shift;
my $read_opts = shift;
my $date_opts = shift;
$self = $self->{PARENT} || $self;
my $res;
if ( $date_opts ) {
my %dates;
$date_opts = get_date_opts ( $date_opts, $self->{CONTROL}->{date_opts} );
change_special_date_vars ( $self->{CONTROL}->{DATES}->{timestamp},
$date_opts, \%dates );
# Temp override of the default date info ...
local $self->{CONTROL}->{date_opts} = $date_opts;
local $self->{CONTROL}->{DATES} = \%dates;
$res = $self->load_config ( $filename, $read_opts );
} else {
$res = $self->load_config ( $filename, $read_opts );
}
DBUG_RETURN ( $res );
}
#######################################
=item $boolean = $cfg->merge_config ( $filename[, %override_read_opts] );
I<$encryptFile>.
Returns: B<1> if something was encrypted. B<-1> if nothing was encrypted.
Otherwise B<0> on error.
=cut
sub encrypt_config_file
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $file = shift;
my $newFile = shift;
my $rOpts = shift;
my $pcfg = $self->{PARENT} || $self;
my $msg;
if ( $file ) {
$file = $self->_fix_path ( $file );
} elsif ( $pcfg->{CONTROL}->{filename} ) {
$file = $pcfg->{CONTROL}->{filename};
} else {
$msg = "You must provide a file name to encrypt!";
}
unless ( $msg || -f $file ) {
$msg = "No such file to encrypt or it's unreadable! -- $file";
}
if ( -l $file && ! $newFile ) {
$msg = "You can't encrypt a file via it's symbolic link -- $file";
}
my $scratch;
if ( $newFile ) {
$scratch = $self->_fix_path ($newFile);
if ( $scratch eq $file ) {
$msg = "Args: file & encryptFile must be different!";
}
} else {
$scratch = $file . ".$$.encrypted";
}
if ( $rOpts ) {
$rOpts = get_read_opts ($rOpts, $pcfg->{CONTROL}->{read_opts});
} else {
$rOpts = $pcfg->{CONTROL}->{read_opts};
}
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 );
}
#######################################
=item $status = $cfg->decrypt_config_file ( [$file[, $decryptFile[, \%rOpts]]] );
This function decrypts all tag values inside the specified config file that are
marked as ready for decryption and generates a new config file with everything
decrypted. If a tag/value pair isn't marked as ready for decryption it is left
alone. By default this label is B<DECRYPT>.
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> or the decryption will fail.
Finally if you provide argument I<$decryptFile>, it will write the decrypted
file to that new file instead of overwriting the current file. This file only
gets created if the return status is B<1>.
If you leave off the I<$file> and I<\%rOpts>, it will instead use the values
inherited from the call to B<new>.
This method ignores any request to source in other config files. You must
decrypt each file individually.
It is an error if basename(I<$file>) is a symbolic link and you didn't provide
I<$decryptFile>.
Returns: B<1> if something was decrypted. B<-1> if nothing was decrypted.
Otherwise B<0> on error.
=cut
sub decrypt_config_file
{
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $file = shift;
my $newFile = shift;
my $rOpts = shift;
my $pcfg = $self->{PARENT} || $self;
my $msg;
if ( $file ) {
$file = $self->_fix_path ( $file );
} elsif ( $pcfg->{CONTROL}->{filename} ) {
$file = $pcfg->{CONTROL}->{filename};
} else {
$msg = "You must provide a file name to encrypt!";
}
unless ( $msg || -f $file ) {
$msg = "No such file to decrypt or it's unreadable! -- $file";
}
if ( -l $file && ! $newFile ) {
$msg = "You can't decrypt a file via it's symbolic link -- $file";
}
my $scratch;
if ( $newFile ) {
$scratch = $self->_fix_path ( $newFile );
if ( $scratch eq $file ) {
$msg = "Args: file & decryptFile must be different!";
}
} else {
$scratch = $file . ".$$.decrypted";
}
if ( $rOpts ) {
$rOpts = get_read_opts ($rOpts, $pcfg->{CONTROL}->{read_opts});
} else {
$rOpts = $pcfg->{CONTROL}->{read_opts};
}
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 );
}
#######################################
=item $out_str = $cfg->encrypt_string ( $string, $alias[, \%rOpts] );
This method takes the passed I<$string> and treats its value as the contents of
a config file, comments and all. Modifying the I<$string> afterwards will not
affect things.
Since there is no filename to work with, it requires the I<$alias> to assist
with the encryption. And since it's required its passed as a separate argument
instead of being buried in the optional I<%rOpts> hash.
It takes the I<$string> and encrypts all tag/value pairs per the rules defined
by C<encrypt_config_file>. Once the contents of I$<string> has been encrypted,
the encrypted string is returned as I<$out_str>. It will return B<undef> on
failure.
You can tell if something was encrypted by comparing I<$string> to I<$out_str>.
=cut
sub encrypt_string
{
DBUG_MASK_NEXT_FUNC_CALL ( 2 ); # mask the alias.
DBUG_ENTER_FUNC ( @_ );
my $self = shift;
my $string = shift; # The string to treat as a config file's contents.
my $alias = shift; # The alias to use during encryption ...
my $read_opts = $self->_get_opt_args ( @_ ); # The override options ...
unless ( $string ) {
my $msg = "You must provide a string to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
unless ( $alias ) {
my $msg = "You must provide an alias to use this method!";
return DBUG_RETURN ( croak_helper ($read_opts, $msg, undef) );
}
# The filename is a reference to the string passed to this method!
my $scratch;
my $src_file = \$string;
my $dst_file = \$scratch;
# Put the alias into the read option hash ...
local $read_opts->{alias} = basename ($alias);
my $pcfg = $self->{PARENT} || $self;
my $rOpts = get_read_opts ($read_opts, $pcfg->{CONTROL}->{read_opts});
( run in 0.799 second using v1.01-cache-2.11-cpan-39bf76dae61 )