view release on metacpan or  search on metacpan

t/20-validate_encrypt_decrypt.t  view on Meta::CPAN

}

# =================================================================

sub compare_cfg
{
   DBUG_ENTER_FUNC (@_);
   my $cfg   = shift;   # The source config file.
   my $dcfg  = shift;   # The config file to comare it to.
   my $lbl   = shift;   # The label to use ...
   my $data  = shift;   # The stats on the source cfg file.
   my $fail  = shift;   # 1-Decrypt should fail.  0-Decrypt should succeed.
   my $which = shift;   # Which tags were decrypted!

   my @sect = $dcfg->find_sections ();
   my $cnt = keys %{$data};
   my $dcnt = @sect;

   dbug_ok (1, "-"x30);
   dbug_is ($cnt, $dcnt, "The ${lbl} config file has the right number of sections.");

   $cnt = 0;
   foreach my $s ( @sect ) {
      unless ( exists $data->{$s} ) {
         dbug_ok (0, "Section '$s' exists in the original config file.");
         next;
      }

      my @tag_list = $dcfg->get_section ($s)->find_tags ();
      my $tcnt = @tag_list;
      ok ( $tcnt == $data->{$s}->{CNT}, "Section '$s' in the ${lbl} cfg file has the right number of tags ($tcnt)" );

      foreach my $t ( @tag_list ) {
         my $stag = $cfg->get_section ($s)->get_value ($t);
         my $dtag = $dcfg->get_section ($s)->get_value ($t);
         unless ( $stag ) {
            dbug_ok (0, "Tag \"${t}\" exists in both config files.");
         } elsif ( ! $which->{$t} ) {
            dbug_cmp_ok ( $stag, 'eq', $dtag, "Tag \"${t}\" has the same value in both config files! ($dtag)" );
         } elsif ( $fail ) {
            dbug_cmp_ok ( $stag, 'ne', $dtag, "Tag \"${t}\" had issues decrypting this value from the config file. ($dtag)" );
         } else {
            dbug_cmp_ok ( $stag, 'eq', $dtag, "Tag \"${t}\" has the same value in both config files. ($dtag)" );
         }
      }
   }

   DBUG_VOID_RETURN ();
}

# =================================================================

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

   my %empty;

   # Empty out the global hashes ...
   %decrypt_callback_tags = %encrypt_callback_tags = %empty;

   my $cfg;
   eval {
      if ( $rOpts ) {
         $cfg = Advanced::Config->new ( $file, $rOpts );
      } else {
         $cfg = Advanced::Config->new ( $file, { encrypt_cb => \&my_security_callback } );
      }
      dbug_isa_ok ($cfg, 'Advanced::Config');
      my $ldr = $cfg->load_config ();
      dbug_ok (defined $ldr, "Advanced::Config object has been loaded into memory!");
   };
   if ( $@ ) {
      unless (defined $cfg) {
         dbug_isa_ok ($cfg, 'Advanced::Config');
      }
      dbug_ok (0, "Advanced::Config object has been loaded into memory!");
      DBUG_LEAVE (3);
   }

   DBUG_RETURN ( $cfg );
}