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