view release on metacpan or  search on metacpan

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

      my ($cfg, @stags) = initialize_each_config ( $control_cfg, $c );

      next  unless ( defined $cfg );

      dbug_ok ($cfg->refresh_config (test_only=>1) ? 0 : 1,
           "No refresh needed for the config file: " . basename ($cfg->filename()));

      foreach my $r ( 0, 1, 2 ) {
         if ( $cfg->refresh_config (force => $r) ) {
            dbug_ok ($r, "This refresh was expeced!");
            fix_space_sep_issue ( $cfg );
         } else {
            dbug_ok (! $r, "Skipping the refresh was expeced!");
         }

         # Finish loading the special case tests # 71 & 72
         # so that they can emulate test # 70 ...
         if ( $c =~ m/_71_empty/ ) {
            local_merge_files ( $control_cfg, $cfg, 0 );
         } elsif ( $c =~ m/_72_empty/ ) {
            local_merge_files ( $control_cfg, $cfg, 1 );
         }

         if ( $#stags == -1 ) {
            # Do a compare against the main section only ...
            compare_config_files ( $main_cfg, $cfg, \%comment_tags );

         } else {
            # Do a compare against the specified section(s) in the new file ...
            $cnt = 0;
            foreach my $t ( sort @stags ) {
               dbug_ok (1, "="x50)  if ( $cnt > 0);
               ++$cnt;

               # Are we looking in another section?
               my $mode = ( $t =~ m/[.]/ ) ? 0 : 2;

               # Look up the name of the section to use ...
               my $sct = $cfg->get_value ($t, required => $mode);
               $sct = $cfg->rule_3_section_lookup ($t)  unless ($sct);
               $sct = $cfg->get_value ($t)  unless ($sct);

               compare_config_files ( $main_cfg, $cfg, \%comment_tags, $sct );
            }
         }
      }   # End foreach $r ...
   }      # End foreach $c ...

   dbug_ok (1, "-"x50);

   # Since I didn't count the test cases, must end my program
   # with a call to this method.  Can't do tests in END anymore!
   done_testing ();

   DBUG_LEAVE (0);
}

# ====================================================================
# This is the source_cb callback function named in: 30-alt_symbol_control.cfg
# All it does is lookup the options to use from the
# appropriate section in the conig file.  (global var)
sub ALTER_SOURCE_CALLBACK_OPTIONS
{
   DBUG_ENTER_FUNC (@_);
   my $file   = shift;
   my $custom = shift;

   my $f = basename ($file);

   DBUG_ENTER_BLOCK ("GRAB");
   DBUG_PAUSE();
   my ($ropts, $dopts, @section_tags) = grab_options ( $control_cfg, $f );
   DBUG_VOID_RETURN ();

   $ropts = print_opts_hash ( "Read Options for: $f", $ropts );
   $dopts = print_opts_hash ( "Date Options for: $f", $dopts );

   DBUG_RETURN ( $ropts, $dopts ); 
}

# ====================================================================
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!");