view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

  # Just specifies the config file to use ...
  $cfg = Advanced::Config->new("MyFile.cfg");

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

   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 $cfg = Advanced::Config->new_section ( $cfg_obj, $section );

# This special case constructor creates a new B<Advanced::Config> object and
# relates it to the given I<$cfg_obj> as a new section named I<$section>.

# It will call die if I<$cfg_obj> is not a valid B<Advanced::Config> object or
# the I<$section> is missing or already in use.

# Returns a reference to this new object.

# =cut

Config.pm  view on Meta::CPAN

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