lib/dbm_filter_util.pl

   1 use strict;
   2 use warnings;
   3
   4 sub StoreData
   5 {
   6     my $hashref = shift ;
   7     my $store = shift ;
   8
   9     my (undef, $file, $line) = caller;
  10     ok 1, "StoreData called from $file, line $line";
  11
  12     ok ref $store eq 'HASH', "Store Data is a hash reference";
  13     ok tied %$hashref, "Storing to tied hash";
  14
  15     while (my ($k, $v) = each %$store) {
  16         no warnings 'uninitialized';
  17         #diag "Stored [$k][$v]";
  18         $$hashref{$k} = $v ;
  19     }
  20
  21 }
  22
  23 sub VerifyData
  24 {
  25     my $hashref = shift ;
  26     my $expected = shift ;
  27     my %expected = %$expected;
  28
  29     my (undef, $file, $line) = caller;
  30     ok 1, "VerifyData called from $file, line $line";
  31
  32     ok ref $expected eq 'HASH', "Expected data is a hash reference";
  33     ok tied %$hashref, "Verifying a tied hash";
  34
  35     my %bad = ();
  36     while (my ($k, $v) = each %$hashref) {
  37         no warnings 'uninitialized';
  38         if ($expected{$k} eq $v) {
  39             #diag "Match [$k][$v]";
  40             delete $expected{$k} ;
  41         }
  42         else {
  43             #diag "No Match [$k][$v]";
  44             $bad{$k} = $v;
  45         }
  46     }
  47
  48     if( ! ok(keys(%bad) + keys(%expected) == 0, "Expected == Actual") ) {
  49         my $bad = "Expected does not match actual\n";
  50         if (keys %expected ) {
  51             $bad .="  No Match from Expected:\n" ;
  52             while (my ($k, $v) = each %expected) {
  53                 $bad .= "\t'$k' =>\t'$v'\n";
  54             }
  55         }
  56         if (keys %bad ) {
  57             $bad .= "\n  No Match from Actual:\n" ;
  58             while (my ($k, $v) = each %bad) {
  59                 no warnings 'uninitialized';
  60                 $bad .= "\t'$k' =>\t'$v'\n";
  61             }
  62         }
  63         diag "${bad}\n" ;
  64     }
  65 }
  66
  67
  68 1;