1use strict;
2use Test::More;
3use Test::Deep;
4use lib 't';
5use common qw( new_dbm );
6
7use_ok( 'DBM::Deep' );
8
9my $dbm_factory = new_dbm(
10    locking   => 1,
11    autoflush => 1,
12    num_txns  => 2,
13);
14while ( my $dbm_maker = $dbm_factory->() ) {
15    my $db1 = $dbm_maker->();
16    next unless $db1->supports('transactions');
17    my $db2 = $dbm_maker->();
18
19    $db1->{x} = { xy => { foo => 'y' } };
20    is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
21    is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" );
22
23    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
24    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
25
26    cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
27    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
28
29    cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
30    cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
31
32    $db1->begin_work;
33
34        cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
35        cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
36
37        cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
38        cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
39
40        cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
41        cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
42
43        is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
44        is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" );
45
46        $db1->{x} = { yz => { bar => 30 } };
47        ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
48        is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" );
49
50        cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
51        cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
52
53    $db1->rollback;
54
55    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
56    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
57
58    cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
59    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
60
61    cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
62    cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
63
64    is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
65    is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" );
66
67    $db1->begin_work;
68
69        cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
70        cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
71
72        cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
73        cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
74
75        cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
76        cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
77
78        is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
79        is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" );
80
81        $db1->{x} = { yz => { bar => 30 } };
82        ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
83        is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X->YZ is Y" );
84
85        cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
86        cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
87
88    $db1->commit;
89
90    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
91    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
92
93    cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
94    cmp_bag( [ keys %{$db2->{x}} ], [qw( yz )], "DB2->X keys correct" );
95
96    cmp_bag( [ keys %{$db1->{x}{yz}} ], [qw( bar )], "DB1->X->XY keys correct" );
97    cmp_bag( [ keys %{$db2->{x}{yz}} ], [qw( bar )], "DB2->X->XY keys correct" );
98}
99
100done_testing;
101