view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

This call creates a new config object and configures it to use the same options
used to set up the B<$otherCfg> object.  Tossing any options provided by this
call to I<new()>.  If B<$otherCfg> used a rule file it is only used when
sourcing in other config files.

=cut

sub copy_opts_from_cfg
{
   DBUG_ENTER_FUNC ( @_ );
   my $self     = shift;
   my $otherCfg = shift;

   $self = $self->{PARENT} || $self;
   $otherCfg = $otherCfg->{PARENT} || $otherCfg;

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

   foreach (keys %{$otherCfg->{CONTROL}->{read_opts}} ) {
      $self->{CONTROL}->{read_opts}->{$_} =
                                     $otherCfg->{CONTROL}->{read_opts}->{$_};
   }

   foreach (keys %{$otherCfg->{CONTROL}->{get_opts}} ) {
      $self->{CONTROL}->{get_opts}->{$_} =
                                     $otherCfg->{CONTROL}->{get_opts}->{$_};
   }

   foreach (keys %{$otherCfg->{CONTROL}->{date_opts}} ) {
      $self->{CONTROL}->{date_opts}->{$_} =
                                     $otherCfg->{CONTROL}->{date_opts}->{$_};
   }

   # Copy the optional rule config file for sourcing in other config files.
   $self->{CONTROL}->{ConfigRuleObj} = $otherCfg->{CONTROL}->{ConfigRuleObj};

   DBUG_RETURN ( $self );
}

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

=item $cfg = $cfg->set_config_rules ( $ruleCfg )

With this method instead of defining the options used in your perl code, you
decided to set up the rules to follow inside another config file which you
loaded into memory via a call to I<newDefineConfigRules()> via B<$ruleCfg>.
In this case the filename option in the call to I<new()> is required.

This method overrides any B<opts> settings to I<new()> and any callback read
options used when sourcing in other config files.

This method becomes usefull when the passed config file sources in other
config files requiring different options to load properly.

   my $cfg = Advanced::Config->new ( "config/myData.cfg" )->
                                   set_config_rules ($ruleCfg);

For example, let's say that B<$ruleCfg> was set up with 4 sections, myData.cfg,
*.cfg, tom*.cfg and *.  And myData.cfg sources in the following 3 files.
bob.cfg, sue.config, and tomfile.cfg.

During the call to I<set_config_rules()> it finds the basename of the passed
filename, myData.cfg, and finds the section named after it and takes the rules
defined in that section and applies it to the congig object. Had this section
not existed, it would have followed the wildcard rules below.

Later on when sourcing in bob.cfg it doesn't find a section called bob.cfg, so
it attempts to lookup the section to use via wildcards and finds section
B<*.cfg>

Next when sourcing in sue.config there is no section called that and it doesn't
match wildcard sections B<*.cfg> or B<tom*.cfg>, so it uses the default section
B<*> to gather the rules from.

Finally for tomfile.cfg it matches both B<*.cfg> and B<tom*.cfg> which is a
fatal error.  To get arround this error you must define a special tag called
B<__order__> and assign it an integer value.  The one with the smallest value
is the name that will match.  So set to 100 for B<tom*.cfg> and 654321 for
B<*.cfg> and it will match B<tom*.cfg>.  It will never match B<*> since it has
an assumed B<__order__> of infinity.

=cut

sub set_config_rules
{
   DBUG_ENTER_FUNC ( @_ );
   my $self    = shift;
   my $ruleCfg = shift;

   $self = $self->{PARENT} || $self;
   $ruleCfg = $ruleCfg->{PARENT} || $ruleCfg;

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

   unless ( $ruleCfg->_chk_if_read_only () ) {
      die "The ruleCfg argument must be created via newDefineConfigRules ()\n";
   }

   my $rule = $ruleCfg->_get_rule_section ( $self->filename () );

   ( $self->{CONTROL}->{read_opts},
     $self->{CONTROL}->{get_opts},
     $self->{CONTROL}->{date_opts} ) = $rule->_get_rules_from_cfg ();

   $self->{CONTROL}->{ConfigRuleObj} = $ruleCfg;

   DBUG_RETURN ( $self );
}

#######################################
# Get all rules from the config file & validate them.

sub _get_rules_from_cfg
{
   DBUG_ENTER_FUNC ( @_ );
   my $ruleCfg = shift;