t/50_audit_trail.t

   1 use strict;
   2 $|=1;
   3
   4 {
   5     # This is here because Tie::File is STOOPID.
   6
   7     package My::Tie::File;
   8     sub TIEARRAY {
   9         my $class = shift;
  10         my ($filename) = @_;
  11
  12         return bless {
  13             filename => $filename,
  14         }, $class;
  15     }
  16
  17     sub FETCH {
  18         my $self = shift;
  19         my ($idx) = @_;
  20
  21         open( my $fh, $self->{filename} );
  22         my @x = <$fh>;
  23         close $fh;
  24
  25         return $x[$idx];
  26     }
  27
  28     sub FETCHSIZE {
  29         my $self = shift;
  30
  31         open( my $fh, $self->{filename} );
  32         my @x = <$fh>;
  33         close $fh;
  34
  35         return scalar @x;
  36     }
  37
  38     sub STORESIZE {}
  39 }
  40
  41 use Test::More tests => 24;
  42
  43 use_ok( 'DBM::Deep' );
  44
  45 my $audit_file = 't/audit.txt';
  46
  47 unlink 't/test.db';
  48 unlink $audit_file;
  49
  50 my @audit;
  51 tie @audit, 'My::Tie::File', $audit_file;
  52
  53 my $db = DBM::Deep->new({
  54     file => 't/test.db',
  55 #    audit_fh => $afh,
  56     audit_file => $audit_file,
  57 });
  58 isa_ok( $db, 'DBM::Deep' );
  59
  60 like(
  61     $audit[0], qr/^\# Database created on/,
  62     "Audit file header written to",
  63 );
  64
  65 $db->{foo} = 'bar';
  66 like( $audit[1], qr{^\$db->{foo} = 'bar';}, "Basic assignment correct" );
  67
  68 $db->{foo} = 'baz';
  69 like( $audit[2], qr{^\$db->{foo} = 'baz';}, "Basic update correct" );
  70
  71 $db->{bar} = { a => 1 };
  72 like( $audit[3], qr{\$db->\{bar\} = \{\};}, "Hash assignment correct" );
  73 like( $audit[4], qr{\$db->\{bar\}\{a\} = '1';}, "... child 1 good" );
  74
  75 $db->{baz} = [ 1 .. 2 ];
  76 like( $audit[5], qr{\$db->{baz} = \[\];}, "Array assignment correct" );
  77 like( $audit[6], qr{\$db->{baz}\[0\] = '1';}, "... child 1 good" );
  78 like( $audit[7], qr{\$db->{baz}\[1\] = '2';}, "... child 2 good" );
  79
  80 {
  81     my $v = $db->{baz};
  82     $v->[5] = [ 3 .. 5 ];
  83     like( $audit[8], qr{\$db->{baz}\[5\] = \[\];}, "Child array assignment correct" );
  84     like( $audit[9], qr{\$db->{baz}\[5\]\[0\] = '3';}, "... child 1 good" );
  85     like( $audit[10], qr{\$db->{baz}\[5]\[1] = '4';}, "... child 2 good" );
  86     like( $audit[11], qr{\$db->{baz}\[5]\[2] = '5';}, "... child 3 good" );
  87 }
  88
  89 undef $db;
  90
  91 $db = DBM::Deep->new({
  92     file => 't/test.db',
  93     audit_file => $audit_file,
  94 });
  95
  96 $db->{new} = 9;
  97 like( $audit[12], qr{\$db->{new} = '9';}, "Writing after closing the file works" );
  98
  99 my $export = $db->export;
 100 undef $db;
 101
 102 {
 103     unlink 't/test2.db';
 104     my $db = DBM::Deep->new({
 105         file => 't/test2.db',
 106     });
 107
 108     for ( @audit ) {
 109         eval "$_";
 110     }
 111
 112     my $export2 = $db->export;
 113
 114     is_deeply( $export2, $export, "And recovery works" );
 115 }
 116
 117 {
 118     $db = DBM::Deep->new({
 119         file => 't/test.db',
 120         audit_file => $audit_file,
 121     });
 122
 123     delete $db->{baz};
 124     like( $audit[13], qr{delete \$db->{baz};}, "Deleting works" );
 125
 126     $export = $db->export;
 127 }
 128
 129 {
 130     unlink 't/test2.db';
 131     my $db = DBM::Deep->new({
 132         file => 't/test2.db',
 133     });
 134
 135     for ( @audit ) {
 136         eval "$_";
 137     }
 138
 139     my $export2 = $db->export;
 140
 141     is_deeply( $export2, $export, "And recovery works" );
 142 }
 143
 144 {
 145     $db = DBM::Deep->new({
 146         file => 't/test.db',
 147         audit_file => $audit_file,
 148     });
 149
 150     $db->{bar}->clear;
 151     like( $audit[14], qr{\$db->{bar} = \{\};}, "Clearing works" );
 152
 153     $export = $db->export;
 154 }
 155
 156 {
 157     unlink 't/test2.db';
 158     my $db = DBM::Deep->new({
 159         file => 't/test2.db',
 160     });
 161
 162     for ( @audit ) {
 163         eval "$_";
 164     }
 165
 166     my $export2 = $db->export;
 167
 168     is_deeply( $export2, $export, "And recovery works" );
 169 }
 170
 171 {
 172     $db = DBM::Deep->new({
 173         file => 't/test.db',
 174         audit_file => $audit_file,
 175     });
 176
 177     $db->{blessed} = bless { a => 5, b => 3 }, 'Floober';
 178     like( $audit[15], qr{\$db->{blessed} = bless {}, 'Floober';},
 179             "Assignment of a blessed reference works" );
 180     like( $audit[16], qr{\$db->{blessed}{a} = '5';}, "... child 1" );
 181     like( $audit[17], qr{\$db->{blessed}{b} = '3';}, "... child 2" );
 182
 183     $export = $db->export;
 184 }
 185
 186 {
 187     unlink 't/test2.db';
 188     my $db = DBM::Deep->new({
 189         file => 't/test2.db',
 190     });
 191
 192     for ( @audit ) {
 193         eval "$_";
 194     }
 195
 196     my $export2 = $db->export;
 197
 198     is_deeply( $export2, $export, "And recovery works" );
 199 }