view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

  # Overrides some of the default featurs of the module ...
  $cfg = Advanced::Config->new("MyFile.cfg",
                          { "assign" => ":=", "comment" => ";" },
                          { "required" => 1, "date_language" => "German" },
                          { "month_type" => 2, "month_language" => "German" } );

=cut

sub new
{
   DBUG_ENTER_FUNC ( @_ );
   my $prototype = shift;
   my $filename  = shift;
   my $read_opts = shift;     # A hash ref of "read" options ...
   my $get_opts  = shift;     # Another hash ref of "get" options ...
   my $date_opts = shift;     # Another hash ref of "date" formatting options ...

   my $class = ref ( $prototype ) || $prototype;
   my $self = {};

   # Create an empty object ...
   bless ( $self, $class );

   # Creating a new object ... (The main section)
   my %control;

   # Initialize what options were selected ...
   $control{filename}  = $self->_fix_path ($filename);
   $control{read_opts} = get_read_opts ( $read_opts );
   $control{get_opts}  = get_get_opts ( $get_opts );
   $control{date_opts} = get_date_opts ( $date_opts );

   $control{read_only} = 0;           # not created via newDefineConfigRules().
   $control{ConfigRuleObj} = undef;   # not set by set_config_rules ().

   my ( %dates, %empty, %mods, %ropts, %rec, @lst );

   # Special Date Variables ...
   set_special_date_vars ($control{date_opts}, \%dates);
   $control{DATES}     = \%dates;
   $control{DATE_USED} = 0;

   # Environment variables referenced ...
   $control{ENV} = \%empty;

   # Timestamps & options used for each config file loaded into memory ...
   # Controls the refesh logic.
   $control{REFRESH_MODIFY_TIME} = \%mods;
   $control{REFRESH_READ_OPTIONS} = \%ropts;

   # Used to detect recursion ...
   $control{RECURSION} = \%rec;

   # Used to detect recursion ...
   $control{MERGE} = \@lst;

   # The count for sensitive entries ...
   $control{SENSITIVE_CNT} = sensitive_cnt ();

   # Assume not allowing utf8/Unicode/Wide Char dates ...
   # Or inside the config file itself.
   $control{ALLOW_UTF8} = 0;

   # Controls the behavior of this module.
   # Only exists in the parent object.
   $self->{CONTROL} = \%control;

   my $key = $self->{SECTION_NAME} = DEFAULT_SECTION;

   my %sections;
   $sections{$key} = $self;
   $self->{SECTIONS} = \%sections;

   # Holds all the tag data for the main section in the config file.
   my %data;
   $self->{DATA} = \%data;

   # Is the data all sensitive?
   $self->{SENSITIVE_SECTION} = 0;   # No for the default section ...

   DBUG_RETURN ( $self );
}

# Only called by Advanced::Config::Reader::read_config() ...
# So not exposed in the POD!
# Didn't rely on read option 'use_utf8' since in many cases
# the option is misleading or just plain wrong!
sub _allow_utf8
{
   DBUG_ENTER_FUNC ( @_ );
   my $self = shift;

   # Tells calls to Advanced::Config::Options::apply_get_rules() that
   # it's ok to use Wide Char Languages like Greek.
   my $pcfg = $self->{PARENT} || $self;
   $pcfg->{CONTROL}->{ALLOW_UTF8} = 1;

   DBUG_VOID_RETURN ();
}

# This private method preps for a clean refresh of the objects contents.
# Kept after the consructor so I can remember to add any new hashes to
# the list below.
sub _wipe_internal_data
{
   DBUG_ENTER_FUNC ( @_ );
   my $self = shift;
   my $file = shift;    # The main config file

   # Wiping the main section automatically wipes everything else ...
   $self = $self->{PARENT} || $self;

   my ( %env, %mods, %rOpts, %rec, @lst, %sect, %data );

   my $key = DEFAULT_SECTION;
   $sect{$key} = $self;

   $self->{CONTROL}->{filename}             = $file;
   $self->{CONTROL}->{ENV}                  = \%env;
   $self->{CONTROL}->{REFRESH_MODIFY_TIME}  = \%mods;
   $self->{CONTROL}->{REFRESH_READ_OPTIONS} = \%rOpts;
   $self->{CONTROL}->{RECURSION}            = \%rec;
   $self->{CONTROL}->{MERGE}                = \@lst;
   $self->{CONTROL}->{SENSITIVE_CNT}        = sensitive_cnt ();
   $self->{CONTROL}->{ALLOW_UTF8}           = 0;

   $self->{SECTIONS} = \%sect;
   $self->{DATA}     = \%data;

   $self->{SENSITIVE_SECTION} = 0;    # Not a sensitive section name!

   DBUG_VOID_RETURN ();
}


#######################################

=item $ruleCfg = Advanced::Config->newDefineConfigRules ( $filename );

This special case constructor creates a new B<Advanced::Config> object, loads
it into memory and validates the resulting config file meets the requirements
for using this method and calls B<die> on any unexpected issues.

The resulting I<$ruleCfg> object is used to replace the 3 B<opts> hashes in the
call to I<new()>, so that all your programs don't have to be modified whenever a
vendor modifies how to parse their config files.   You just need to modify this
configutation file and all your programs using it are updated all at once.

Config.pm  view on Meta::CPAN

   }

   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;

   if ( $self->_chk_if_read_only () ) {
      die "You may not override rules for object created by newDefineConfigRules ()\n";
   }

   # 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 );