t/50_audit_trail.t

   1 use strict;
   2 use warnings;
   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 use t::common qw( new_fh );
  43
  44 use_ok( 'DBM::Deep' );
  45
  46 my ($audit_fh, $audit_file) = new_fh();
  47
  48 my @audit;
  49 tie @audit, 'My::Tie::File', $audit_file;
  50
  51 my ($fh, $filename) = new_fh();
  52 my $db = DBM::Deep->new({
  53     file       => $filename,
  54     audit_file => $audit_file,
  55     #autuflush  => 1,
  56 });
  57 isa_ok( $db, 'DBM::Deep' );
  58
  59 like(
  60     $audit[0], qr/^\# Database created on/,
  61     "Audit file header written to",
  62 );
  63
  64 $db->{foo} = 'bar';
  65 like( $audit[1], qr{^\$db->{foo} = 'bar';}, "Basic assignment correct" );
  66
  67 $db->{foo} = 'baz';
  68 like( $audit[2], qr{^\$db->{foo} = 'baz';}, "Basic update correct" );
  69
  70 $db->{bar} = { a => 1 };
  71 like( $audit[3], qr{\$db->\{bar\} = \{\};}, "Hash assignment correct" );
  72 like( $audit[4], qr{\$db->\{bar\}\{a\} = '1';}, "... child 1 good" );
  73
  74 $db->{baz} = [ 1 .. 2 ];
  75 like( $audit[5], qr{\$db->{baz} = \[\];}, "Array assignment correct" );
  76 like( $audit[6], qr{\$db->{baz}\[0\] = '1';}, "... child 1 good" );
  77 like( $audit[7], qr{\$db->{baz}\[1\] = '2';}, "... child 2 good" );
  78
  79 {
  80     my $v = $db->{baz};
  81     $v->[5] = [ 3 .. 5 ];
  82     like( $audit[8], qr{\$db->{baz}\[5\] = \[\];}, "Child array assignment correct" );
  83     like( $audit[9], qr{\$db->{baz}\[5\]\[0\] = '3';}, "... child 1 good" );
  84     like( $audit[10], qr{\$db->{baz}\[5]\[1] = '4';}, "... child 2 good" );
  85     like( $audit[11], qr{\$db->{baz}\[5]\[2] = '5';}, "... child 3 good" );
  86 }
  87
  88 undef $db;
  89
  90 $db = DBM::Deep->new({
  91     file => $filename,
  92     audit_file => $audit_file,
  93 });
  94
  95 $db->{new} = 9;
  96 like( $audit[12], qr{\$db->{new} = '9';}, "Writing after closing the file works" );
  97
  98 my $export = $db->export;
  99 undef $db;
 100
 101 {
 102     my ($fh2, $file2) = new_fh();
 103     my $db = DBM::Deep->new({
 104         file => $file2,
 105     });
 106
 107     for ( @audit ) {
 108         eval "$_";
 109     }
 110
 111     my $export2 = $db->export;
 112
 113     is_deeply( $export2, $export, "And recovery works" );
 114 }
 115
 116 {
 117     $db = DBM::Deep->new({
 118         file => $filename,
 119         audit_file => $audit_file,
 120     });
 121
 122     delete $db->{baz};
 123     like( $audit[13], qr{delete \$db->{baz};}, "Deleting works" );
 124
 125     $export = $db->export;
 126 }
 127
 128 {
 129     my ($fh2, $file2) = new_fh();
 130     my $db = DBM::Deep->new({
 131         file => $file2,
 132     });
 133
 134     for ( @audit ) {
 135         eval "$_";
 136     }
 137
 138     my $export2 = $db->export;
 139
 140     is_deeply( $export2, $export, "And recovery works" );
 141 }
 142
 143 SKIP: {
 144     skip 'Not done yet', 1;
 145     $db = DBM::Deep->new({
 146         file => $filename,
 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     my ($fh2, $file2) = new_fh();
 158     my $db = DBM::Deep->new({
 159         file => $file2,
 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 SKIP: {
 172     skip "Not working", 3;
 173     $db = DBM::Deep->new({
 174         file => $filename,
 175         audit_file => $audit_file,
 176     });
 177
 178     $db->{blessed} = bless { a => 5, b => 3 }, 'Floober';
 179     like( $audit[15], qr{\$db->{blessed} = bless {}, 'Floober';},
 180             "Assignment of a blessed reference works" );
 181     like( $audit[16], qr{\$db->{blessed}{a} = '5';}, "... child 1" );
 182     like( $audit[17], qr{\$db->{blessed}{b} = '3';}, "... child 2" );
 183
 184     $export = $db->export;
 185 }
 186
 187 {
 188     my ($fh2, $file2) = new_fh();
 189     my $db = DBM::Deep->new({
 190         file => $file2,
 191     });
 192
 193     for ( @audit ) {
 194         eval "$_";
 195     }
 196
 197     my $export2 = $db->export;
 198
 199     is_deeply( $export2, $export, "And recovery works" );
 200 }