[dbsrgits/DBM-Deep.git] / t / 41_transaction_multilevel.t

use strict;
use Test::More tests => 41;
use Test::Deep;
use t::common qw( new_fh );

use_ok( 'DBM::Deep' );

my ($fh, $filename) = new_fh();
my $db1 = DBM::Deep->new(
    file => $filename,
    fh => $fh,
    locking => 1,
    autoflush => 1,
    num_txns  => 2,
);
seek $db1->_get_self->_engine->storage->{fh}, 0, 0;

my $db2 = DBM::Deep->new(
    file => $filename,
    fh => $fh,
    locking => 1,
    autoflush => 1,
    num_txns  => 2,
);

$db1->{x} = { xy => { foo => 'y' } };
is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" );

#warn $db1->_dump_file;
$db1->begin_work;

    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );

    cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );

    cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
    cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );

    is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
    is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" );

    $db1->{x} = { yz => { bar => 30 } };
    ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
    is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" );

    cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );

#warn $db1->_dump_file;
$db1->rollback;
__END__
cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );

cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );

cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );

is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" );

$db1->begin_work;

    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );

    cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );

    cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
    cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );

    is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
    is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" );

    $db1->{x} = { yz => { bar => 30 } };
    ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
    is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X->YZ is Y" );

    cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );

$db1->commit;

cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );

cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
cmp_bag( [ keys %{$db2->{x}} ], [qw( yz )], "DB2->X keys correct" );

cmp_bag( [ keys %{$db1->{x}{yz}} ], [qw( bar )], "DB1->X->XY keys correct" );
cmp_bag( [ keys %{$db2->{x}{yz}} ], [qw( bar )], "DB2->X->XY keys correct" );

$db1->_get_self->_engine->storage->close( $db1->_get_self );
$db2->_get_self->_engine->storage->close( $db2->_get_self );
Commit	Line	Data
2120a181	1	use strict;
45f047f8	2	use Test::More tests => 41;
2120a181	3	use Test::Deep;
	4	use t::common qw( new_fh );
	5
	6	use_ok( 'DBM::Deep' );
	7
	8	my ($fh, $filename) = new_fh();
	9	my $db1 = DBM::Deep->new(
	10	file => $filename,
45f047f8	11	fh => $fh,
2120a181	12	locking => 1,
2120a181	13	autoflush => 1,
c57b19c6	14	num_txns => 2,
2120a181	15	);
f1879fdc	16	seek $db1->_get_self->_engine->storage->{fh}, 0, 0;
2120a181	17
	18	my $db2 = DBM::Deep->new(
	19	file => $filename,
45f047f8	20	fh => $fh,
2120a181	21	locking => 1,
2120a181	22	autoflush => 1,
c57b19c6	23	num_txns => 2,
2120a181	24	);
2120a181	25
45f047f8	26	$db1->{x} = { xy => { foo => 'y' } };
	27	is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
	28	is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" );
2120a181	29
db2eb673	30	#warn $db1->_dump_file;
2120a181	31	$db1->begin_work;
	32
	33	cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
	34	cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
	35
45f047f8	36	cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
45f047f8	37	cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
2120a181	38
45f047f8	39	cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
45f047f8	40	cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
2120a181	41
45f047f8	42	is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
45f047f8	43	is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" );
2120a181	44
45f047f8	45	$db1->{x} = { yz => { bar => 30 } };
	46	ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
	47	is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" );
	48
	49	cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
	50	cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
2120a181	51
db2eb673	52	#warn $db1->_dump_file;
2120a181	53	$db1->rollback;
db2eb673	54	__END__
2120a181	55	cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
	56	cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
	57
45f047f8	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" );
2120a181	63
45f047f8	64	is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
45f047f8	65	is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" );
2120a181	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
45f047f8	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" );
2120a181	77
45f047f8	78	is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
45f047f8	79	is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" );
2120a181	80
45f047f8	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" );
2120a181	84
45f047f8	85	cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
45f047f8	86	cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
2120a181	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
45f047f8	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
f1879fdc	99	$db1->_get_self->_engine->storage->close( $db1->_get_self );
f1879fdc	100	$db2->_get_self->_engine->storage->close( $db2->_get_self );