view release on metacpan or  search on metacpan

t/35-improper_tests.t  view on Meta::CPAN

      my $hash_ref2 = $cfg2->get_hash_values ( "00_has_variables" );

      foreach my $t ( $lCfg->find_tags () ) {
         my $v = $lCfg->get_value ($t);
         my $bool = $lCfg->chk_if_still_uses_variables ($t);
         my $ans = ( $v =~ m/[$][{][^}]+[}]/ ) ? 1 : 0;  # Check for a variable definition.
         my $agree = ($bool == $ans) ? 1 : 0;

         if ( exists $hash_ref2->{$t} ) {
            dbug_ok ( $agree && $bool, "Tag '$t' has unresolved variables in it!  ($v)" );
         } elsif ( $ans || $bool ) {
            dbug_ok ( 0, "Tag '$t' has NO variables in it!  ($v)  [$ans, $bool]" );
         }
      }
   }

   # --------------------------------------------------------------
   # Section # 3: Now testing which tags failed to decrypt!
   # --------------------------------------------------------------
   foreach my $s ( @sections ) {
      dbug_ok (1, "-"x50);
      my $lCfg = $cfg3->get_section ( $s );
      dbug_ok (1, "Disabled Decryption test for section: " . $s);
      my $hash_ref3 = $cfg3->get_hash_values ( "00_has_decryption" );

      foreach my $t ( $lCfg->find_tags () ) {
         my $v = $lCfg->get_value ($t);
         my $chk = $lCfg->chk_if_still_encrypted ($t);

         my $bool = $lCfg->chk_if_still_uses_variables ($t);
         my $ans = ( $v =~ m/[$][{][^}]+[}]/ ) ? 1 : 0;  # Check for a variable definition.
         my $agree = ($bool == $ans) ? 1 : 0;

         if ( exists $hash_ref3->{$t} ) {
            if ( $bool || $ans ) {
               dbug_ok ( 0, "Tag '$t' references an encrypted value ($v)" );
            } else {
               dbug_ok ( $chk, "Tag '$t' references an encrypted value ($v)" );
            }
         } elsif ( $chk ) {
            dbug_ok ( 0, "Tag '$t' is correctly marked as encrypted ($v)" );
         }
      }
   }

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

sub make_object
{
   DBUG_ENTER_FUNC ( @_ );
   my $file  = shift;
   my %rOpts = @_;

   my $cfg;
   eval {
      $cfg = Advanced::Config->new ( undef, \%rOpts, { required => 1 } );
      dbug_isa_ok ($cfg, 'Advanced::Config');
      my $ldr = $cfg->merge_config ( $file );
      dbug_ok (defined $ldr, "Advanced::Config object has been loaded into memory via merge!");
   };
   if ( $@ ) {
      unless (defined $cfg) {
         dbug_isa_ok ($cfg, 'Advanced::Config');
      }
      dbug_ok (0, "Advanced::Config object has been loaded into memory via merge!");
      DBUG_LEAVE (3);
   }

   # So can tell when the config file finished loading in fish ...
   DBUG_PRINT ("====", "%s", "="x50);

   DBUG_RETURN ( $cfg );
}