view release on metacpan or  search on metacpan

t/75-check_all_languages.t  view on Meta::CPAN

             "Both normal objects are the same!" );
   dbug_ok (1, "----------------- UTF-8 Encrypted -------------------------");
   dbug_ok ( compare_objects ( $cfg2, $cfg4 ),
             "Both UTF-8 objects are the same!" );

   dbug_ok (1, "----------------- Regular Decrypted -----------------------");
   dbug_ok ( compare_objects ( $cfg1, $cfg5 ),
             "Both normal objects are the same!" );
   dbug_ok (1, "----------------- UTF-8 Decrypted -------------------------");
   dbug_ok ( compare_objects ( $cfg2, $cfg6 ),
             "Both UTF-8 objects are the same!" );
   dbug_ok (1, "---------------------- Done! ------------------------------");

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

# --------------------------------------------------------------------
# Create a new Advanced::Config objact ...
# --------------------------------------------------------------------
sub build_new_object
{
   DBUG_ENTER_FUNC (@_);
   my $mode_utf8 = shift;     # 0 or 1.
   my $lbl       = shift;     # Initial, Encrypted or Decrypted
   my $pause     = shift;     # 0 or 1.
   my $file      = shift;

   my $cfg = Advanced::Config->new ( $file,
                                     { croak => 1,    use_utf8 => $mode_utf8,
                                       dbug_test_use_case_parse_override  => 1,
                                       dbug_test_use_case_hide_override   => 1,
                                       disable_variable_modifiers => 1 },
                                     { required => 0, date_enable_yy => 1 },
                                     { }
                                   );

   my $type = $mode_utf8 ? "UTF-8" : "normal";
   dbug_isa_ok ( $cfg, "Advanced::Config" );
   dbug_isa_ok ( pause_load ($cfg, $pause), "Advanced::Config" );

   DBUG_RETURN ( $cfg );
}

# --------------------------------------------------------------------
sub pause_load
{
   DBUG_ENTER_FUNC (@_);
   my $cfg   = shift;
   my $pause = shift;

   DBUG_PAUSE ()  if ( $pause );

   DBUG_RETURN ( $cfg->load_config () );
}

# --------------------------------------------------------------------
# Compares 2 Advanced::Config objects and verify they are the same!
# Stops on any error encountered.
# --------------------------------------------------------------------
sub compare_objects
{
   DBUG_ENTER_FUNC (@_);
   my $cfg_src = shift;
   my $cfg_dst = shift;

   DBUG_PAUSE ()  unless ( $run_as_developer );

   my @src = $cfg_src->find_sections ();
   my @dst = $cfg_src->find_sections ();
   unless (dbug_is ( $#src, $#dst, "Both objects have the same number of sections in them!" )) {
      return DBUG_RETURN (0);
   }

    my $stop = 0;
   foreach (@src) {
      my $sCfg1 = $cfg_src->get_section ( $_ );
      my $sCfg2 = $cfg_dst->get_section ( $_ );

      my $sts = ( $sCfg1 && $sCfg2 ) ? 1 : 0;
      unless (dbug_ok ($sts, "Section '$_' exists in both objects!")) {
         $stop = 1;
         last;
      }

      my @tags1 = $sCfg1->find_tags ();
      my @tags2 = $sCfg2->find_tags ();
      unless (dbug_is ( $#tags1, $#tags2, "Both copies of section '$_' have the same number of tags in them!")) {
         $stop = 1;
         last;
      }

      foreach my $t (@tags1) {
         my $val1 = $sCfg1->get_value ($t);
         my $val2 = $sCfg2->get_value ($t);
         $sts = ( defined $val2 && $val1 eq $val2 ) ? 1 : 0;
         unless ( dbug_ok ($sts, "Tag '$t' in both objects have the same value ($val1) ($val2)" ) ) {
            $stop = 1;
         }
      }
      last  if ( $stop );
   }

   DBUG_RETURN ( $stop ? 0 : 1 );
}

# --------------------------------------------------------------------
# Now onto validating we can read the config file we created ...
# --------------------------------------------------------------------
sub test_array
{
   my $cfg    = shift;
   my $lbl    = shift;
   my $lang   = shift;
   my $tag    = shift;
   my $months = shift;   # Ref to MoY or MoYs ...

   my ($bad, $good) = (0, 0);