view release on metacpan or  search on metacpan

t/55-validate-strings.t  view on Meta::CPAN

   # Now some more detailed comparisons of the results ...
   # ----------------------------------------------------------
   my $xCfg1 = init_config ( $original );
   my $xCfg2 = init_config ( $str1, $alias );   # Decryption works ...
   my $xCfg3 = init_config ( $str1 );           # Decryption fails ...
   my $xCfg4 = init_config ( $str2 );

   dbug_ok ((defined $str1 && $str1 ne $original), "Encrypting a string looks good!");
   dbug_ok ((defined $str2 && $str2 ne $str1), "Decrypting a string looks good!");

   my $sxCfg1 = $xCfg1->get_section ($sect);
   my $sxCfg2 = $xCfg2->get_section ($sect);
   my $sxCfg3 = $xCfg3->get_section ($sect);
   my $sxCfg4 = $xCfg4->get_section ($sect);
   dbug_ok ( defined $sxCfg1, "Section exists" );
   dbug_ok ( defined $sxCfg2, "Section exists" );
   dbug_ok ( defined $sxCfg3, "Section exists" );
   dbug_ok ( defined $sxCfg4, "Section exists" );

   # This is a lousy test ... Remove & update $original when detailed test available!
   dbug_cmp_ok ( $str2, 'eq', $original, "Encrypting then decrypting produced the correct string!" );

   dbug_ok ( test_obj ($xCfg1, $xCfg2, [ "abc", "xyz" ], [] ), "Compares main OK" );
   dbug_ok ( test_obj ($sxCfg1, $sxCfg2, [ "lmn", "no" ], [] ),  "Compares section OK" );

   dbug_ok ( test_obj ($xCfg1, $xCfg3, [], [ "abc", "xyz" ] ), "Decrypts main Failed as expected" );
   dbug_ok ( test_obj ($sxCfg1, $sxCfg3, [ "no" ], [ "lmn" ] ),  "Decrypts section Failed as expected" );

   dbug_ok ( test_obj ($xCfg1, $xCfg4, [ "abc", "xyz" ], [] ), "Decrypts main OK" );
   dbug_ok ( test_obj ($sxCfg1, $sxCfg4, [ "lmn", "no" ], [] ),  "Decrypts section OK" );

   # ----------------------------------------------------------
   # Does the toString () test cases ...
   # ----------------------------------------------------------
   dbug_ok ( 1, "-"x50 );

   # Makes sure having comments in a tag's value doesn't cause us problems!
   $xCfg1->set_value ("cmt1", '### Comments ###');
   $xCfg1->set_value ("cmt2", '### "Comments" ###');
   $xCfg1->set_value ("cmt3", "### 'Comments' ###");
   $xCfg1->set_value ("cmt4", "### 'Comments" . '" ###');

   my $str = $xCfg1->toString ();

   my $zCfg1 = init_config ( $str );

   my $szCfg1 = $zCfg1->get_section ($sect);
   dbug_ok ( defined $szCfg1, "Section exists" );

   dbug_ok ( defined $str, "toString() returned something!" );

   dbug_ok ( test_obj ($xCfg1, $zCfg1,  [ "abc", "xyz", "cmt1", "cmt2", "cmt3", "cmt4" ], [] ), "Compares main OK" );
   dbug_ok ( test_obj ($sxCfg1, $szCfg1, [ "lmn", "no" ], [] ),  "Compares section OK" );

   # Mark all tags to be encrypted ...
   $str = $xCfg1->toString (1);
   dbug_ok ( defined $str, "toString(1) returned something!" );
   $str2 = $xCfg1->encrypt_string ($str, $alias);
   dbug_ok ( defined $str2, "encrypt_string() returned something!" );

   my $flag = (defined $str && defined $str2) && $str ne $str2;
   dbug_ok ( $flag, "The toString(1) results have been encrypted!");

   my $zCfg2 = init_config ( $str2 );
   my $szCfg2 = $zCfg2->get_section ($sect);
   dbug_ok ( defined $szCfg2, "Section exists" );

   my $zCfg3 = init_config ( $str2, $alias );
   my $szCfg3 = $zCfg3->get_section ($sect);
   dbug_ok ( defined $szCfg3, "Section exists" );

   dbug_ok ( test_obj ($xCfg1, $zCfg2,  [], [ "abc", "xyz", "cmt1", "cmt2", "cmt3", "cmt4" ] ), "Decrypts main Failed as expected" );
   dbug_ok ( test_obj ($sxCfg1, $szCfg2, [], [ "lmn", "no" ] ),  "Decrypts section Failed as expected" );

   dbug_ok ( test_obj ($xCfg1, $zCfg3,  [ "abc", "xyz", "cmt1", "cmt2", "cmt3", "cmt4" ], [] ), "Decrypts main OK" );
   dbug_ok ( test_obj ($sxCfg1, $szCfg3, [ "lmn", "no" ], [] ),  "Decrypts section OK" );

   # ----------------------------------------------------------
   # Does the toString () test using alternate symbols ...
   # ----------------------------------------------------------
   dbug_ok ( 1, "-"x50 );
   $xCfg1->set_value ("cmt1", '//// Comments ///');
   $xCfg1->set_value ("cmt2", '//// "Comments" ///');
   $xCfg1->set_value ("cmt3", "//// 'Comments' ///");
   $xCfg1->set_value ("cmt4", "//// 'Comments" . '" ///');

   $str = $xCfg1->toString (1, "comment" => "//", "assign" => ":=:", "encrypt_lbl" => "Some Comments ...");
   dbug_ok ( defined $str, "toString(2) returned something!" );

   my $zCfg5 = init_config ( $str, $alias, 1);
   my $szCfg5 = $zCfg5->get_section ($sect);
   dbug_ok ( defined $szCfg5, "Section exists" );

   dbug_ok ( test_obj ($xCfg1, $zCfg5,  [ "abc", "xyz", "cmt1", "cmt2", "cmt3", "cmt4" ], [] ), "Compares alternate main OK" );
   dbug_ok ( test_obj ($sxCfg1, $szCfg5, [ "lmn", "no" ], [] ),  "Compares alternate section OK" );

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


# --------------------------------------------------
# Compares two Advanced::Config objects ...
# --------------------------------------------------
sub test_obj
{
   DBUG_ENTER_FUNC ( @_ );
   my $src  = shift;
   my $dst  = shift;
   my $good = shift;   # Array of tags that should match
   my $bad  = shift;   # Array of tags that shouldn't match

   unless ( defined $src && defined $dst ) {
      return DBUG_RETURN (0);
   }

   DBUG_PAUSE ();

   # It's a fatal error if any tag in the "good" array doesn't exist!