Commit | Line | Data |
359a01ac |
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 | |
e82621dd |
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 "$_"; |
25c7c8d6 |
52 | warn "$_ -> $@\n" if $@; |
e82621dd |
53 | } |
54 | |
55 | my $export2 = $db->export; |
25c7c8d6 |
56 | # use Data::Dumper;warn Dumper $export2; |
e82621dd |
57 | |
58 | cmp_deeply( $export2, $export, "And recovery works" ); |
59 | } |
60 | |
61 | use Test::More tests => 12; |
62 | use Test::Deep; |
359a01ac |
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'; |
e82621dd |
86 | testit( $db, \@audit ); |
359a01ac |
87 | |
359a01ac |
88 | $db->{foo} = 'baz'; |
e82621dd |
89 | testit( $db, \@audit ); |
359a01ac |
90 | |
91 | $db->{bar} = { a => 1 }; |
e82621dd |
92 | testit( $db, \@audit ); |
359a01ac |
93 | |
94 | $db->{baz} = [ 1 .. 2 ]; |
e82621dd |
95 | testit( $db, \@audit ); |
359a01ac |
96 | |
97 | { |
98 | my $v = $db->{baz}; |
99 | $v->[5] = [ 3 .. 5 ]; |
e82621dd |
100 | testit( $db, \@audit ); |
359a01ac |
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; |
e82621dd |
111 | testit( $db, \@audit ); |
359a01ac |
112 | |
e82621dd |
113 | delete $db->{baz}; |
114 | testit( $db, \@audit ); |
359a01ac |
115 | |
e82621dd |
116 | $db->{bar}->clear; |
117 | testit( $db, \@audit ); |
359a01ac |
118 | |
e82621dd |
119 | $db->{blessed} = bless { a => 5, b => 3 }, 'Floober'; |
120 | testit( $db, \@audit ); |