view release on metacpan or  search on metacpan

t/30-alt_symbols_cfg.t  view on Meta::CPAN

   } else {
      dbug_is ( $cnt1, $cnt2, "Both config files have the same number of tags in them.  ($cnt1 vs $cnt2)");
   }

   my %list;
   foreach my $tg ( @src_list ) {
      $list{$tg} = 1;
      my $src = $src_cfg->get_value ( $tg );
      my $dst = $dst_cfg->get_value ( $tg );
      my $same = ( $src eq $dst ) ? 1 : 0;
      if ( $cmts->{$tg} ) {
         dbug_ok ( 1, "Tag '$tg' in both files may have different comment values!");
      } else {
         dbug_ok ( $same, "Tag '$tg' in both files have the same value!");
      }
      unless ( $same ) {
         DBUG_PRINT ("DIFF", "%s <-vs-> %s", $src, $dst);
      }
   }

   # Should never find anything!
   foreach ( @dst_list ) {
      next  if ( $list{$_} );
      dbug_ok (0, "Found unexpected tag '$_' in new config file.");
   }

   DBUG_VOID_RETURN ();
}

# ====================================================================
# Common initialization logic for each config file loaded into memory!

sub initialize_config
{
   DBUG_ENTER_FUNC (@_);
   my $file  = shift;
   my $ropts = shift;
   my $gopts = shift;
   my $dopts = shift;

   my $space_sep = is_assign_spaces ( $ropts );
   $ropts->{$oTag} = 1   if ( $space_sep );

   my $f1 = File::Spec->catfile ("t", "config", $file);
   my $iCfg;
   eval {
      $iCfg = Advanced::Config->new ($f1, $ropts, $gopts, $dopts);
      dbug_isa_ok ($iCfg, 'Advanced::Config');
      my $ldr = $iCfg->load_config ();
      dbug_ok (defined $ldr, "Advanced::Config object has been loaded into memory!");
   };
   if ( $@ ) {
      unless (defined $iCfg) {
         dbug_isa_ok ($iCfg, 'Advanced::Config');
      }
      dbug_ok (0, "Advanced::Config object has been loaded into memory!");
      DBUG_LEAVE (3);
   }

   if ( $space_sep ) {
      DBUG_PRINT ("SPECIAL CASE", "Need to rename all tags with '=' in their names!");
      fix_space_sep_issue ( $iCfg );
   }

   DBUG_RETURN ( $iCfg );
}

# ====================================================================
# This function is a hack!!!
# There must normally never be an "=" in a tag's name for this to work!
# ====================================================================
# If using the special case of spaces separating the tag/value pair,
# will need to replace all "=" in the tag names to make them equivilant
# to the other config files.

sub fix_space_sep_issue
{
   DBUG_ENTER_FUNC (@_);
   my $cfg = shift;    # The config file to fix ...

   foreach my $name ( $cfg->find_sections () ) {
      my $s = $cfg->get_section ($name);
      foreach my $t ( $s->find_tags ("=") ) {
         my $new = $t;
         $new =~ s/=/ /g;
         $s->rename_tag ($t, $new);
      }
   }

   DBUG_VOID_RETURN ();
}

# ====================================================================
# Simulates the normal initialize_config () call ...
# By merging in the expected files ...

sub local_merge_files
{
   DBUG_ENTER_FUNC (@_);
   my $ctl_cfg  = shift;
   my $new_cfg  = shift;
   my $multiple = shift;

   my $f1 = File::Spec->catfile ("t", "config", "30-alt_symbols_03.cfg");
   my $f2 = File::Spec->catfile ("t", "config", "30-alt_symbols_04 multi section test.cfg");

   my ($ropt1, $dopt1) = grab_options ($ctl_cfg, basename ($f1));
   my ($ropt2, $dopt2) = grab_options ($ctl_cfg, basename ($f2));

   # What to do with $dopt???

   dbug_ok ($new_cfg->merge_config ($f1, $ropt1), "1st Merge is OK");
   dbug_ok ($new_cfg->merge_config ($f2, $ropt2), "2nd Merge is OK");

   if ( $multiple ) {
      dbug_ok ($new_cfg->merge_config ($f1, $ropt1), "3rd Merge is OK");
      dbug_ok ($new_cfg->merge_config ($f2, $ropt2), "4th Merge is OK");
   }

   DBUG_VOID_RETURN ();
}

# ====================================================================
# The generic config file loader ...
# ====================================================================
sub initialize_each_config
{
   DBUG_ENTER_FUNC (@_);
   my $ctrl_cfg = shift;
   my $file     = shift;

   my @section_tags;   # List of sections to compare against ...
   my $ropts;
   my $dopts;

   ($ropts, $dopts, @section_tags) = grab_options ( $ctrl_cfg, $file );

   # Always die if we can't locate tags in this config file.
   my %gopts = ( required => 2 );

   my $cfg = initialize_config ( $file, $ropts, \%gopts, $dopts );

   DBUG_RETURN ( $cfg, @section_tags );
}

# ====================================================================