view release on metacpan or  search on metacpan

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

# ====================================================================
sub compare_config_files
{
   DBUG_ENTER_FUNC (@_);
   my $src_cfg  = shift;    # The original validated config file to compare against.
   my $dst_cfg  = shift;    # The new config file to validate.
   my $cmts     = shift;    # The tags with comment chars in their values!
   my $sect     = shift;    # The section to change to.

   my ( $cnt1, $cnt2 );

   my @sections = $dst_cfg->find_sections ();
   $cnt1 = @sections;
   dbug_cmp_ok ($cnt1, '>', 0, "The config file has ${cnt1} section(s)!");

   if ( $sect ) {
      $dst_cfg = $dst_cfg->get_section ( $sect );
      dbug_ok (defined $dst_cfg, "Validating against section \"${sect}\" in the config file ...");
      return DBUG_VOID_RETURN ()  unless ( defined $dst_cfg );
   } else {
      dbug_ok (1, "Validating the config file ...");
   }

   my @src_list = $src_cfg->find_tags ();
   my @dst_list = $dst_cfg->find_tags ();
   $cnt1 = @src_list;
   $cnt2 = @dst_list;
   if ( $sect ) {
      dbug_is ( $cnt1, $cnt2, "The source config file & section '$sect' have the same number of tags in them.  ($cnt1 vs $cnt2)");
   } 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 ();
}