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 sub testit {
  42     my ($db_orig, $audit) = @_;
  43     my $export = $db_orig->export;
  44
  45     my ($fh2, $file2) = new_fh();
  46     my $db = DBM::Deep->new({
  47         file => $file2,
  48     });
  49
  50     for ( @$audit ) {
  51         eval "$_";
  52     }
  53
  54     my $export2 = $db->export;
  55
  56     cmp_deeply( $export2, $export, "And recovery works" );
  57 }
  58
  59 use Test::More tests => 12;
  60 use Test::Deep;
  61 use t::common qw( new_fh );
  62
  63 use_ok( 'DBM::Deep' );
  64
  65 my ($audit_fh, $audit_file) = new_fh();
  66
  67 my @audit;
  68 tie @audit, 'My::Tie::File', $audit_file;
  69
  70 my ($fh, $filename) = new_fh();
  71 my $db = DBM::Deep->new({
  72     file       => $filename,
  73     audit_file => $audit_file,
  74     #autuflush  => 1,
  75 });
  76 isa_ok( $db, 'DBM::Deep' );
  77
  78 like(
  79     $audit[0], qr/^\# Database created on/,
  80     "Audit file header written to",
  81 );
  82
  83 $db->{foo} = 'bar';
  84 testit( $db, \@audit );
  85
  86 $db->{foo} = 'baz';
  87 testit( $db, \@audit );
  88
  89 $db->{bar} = { a => 1 };
  90 testit( $db, \@audit );
  91
  92 $db->{baz} = [ 1 .. 2 ];
  93 testit( $db, \@audit );
  94
  95 {
  96     my $v = $db->{baz};
  97     $v->[5] = [ 3 .. 5 ];
  98     testit( $db, \@audit );
  99 }
 100
 101 undef $db;
 102
 103 $db = DBM::Deep->new({
 104     file => $filename,
 105     audit_file => $audit_file,
 106 });
 107
 108 $db->{new} = 9;
 109 testit( $db, \@audit );
 110
 111 delete $db->{baz};
 112 testit( $db, \@audit );
 113
 114 $db->{bar}->clear;
 115 testit( $db, \@audit );
 116
 117 $db->{blessed} = bless { a => 5, b => 3 }, 'Floober';
 118 testit( $db, \@audit );