5 use Test::More tests => 17;
8 use t::common qw( new_fh );
10 use_ok( 'DBM::Deep' );
12 # Failure cases to make sure that things are caught right.
13 foreach my $type ( DBM::Deep->TYPE_HASH, DBM::Deep->TYPE_ARRAY ) {
14 my ($fh, $filename) = new_fh();
15 my $db = DBM::Deep->new({
24 } qr/Cannot import a scalar/, "Importing a scalar to type '$type' fails";
26 # Load a ref of the wrong type
27 # Load something with bad stuff in it
31 $db->import( { foo => 'bar' } );
32 } qr/Cannot import a hash into an array/, "Wrong type fails";
35 $db->import( [ \$x ] );
36 } qr/Storage of references of type 'SCALAR' is not supported/, "Bad stuff fails";
40 $db->import( [ 1 .. 3 ] );
41 } qr/Cannot import an array into a hash/, "Wrong type fails";
44 $db->import( { foo => \$x } );
45 } qr/Storage of references of type 'SCALAR' is not supported/, "Bad stuff fails";
50 my ($fh, $filename) = new_fh();
51 my $db = DBM::Deep->new({
58 # Create structure in memory
63 array1 => [ "elem0", "elem1", "elem2" ],
65 subkey1 => "subvalue1",
66 subkey2 => "subvalue2",
67 subkey3 => bless( { a => 'b' }, 'Foo' ),
71 $db->import( $struct );
78 array1 => [ 'elem0', 'elem1', 'elem2', ],
80 subkey1 => "subvalue1",
81 subkey2 => "subvalue2",
82 subkey3 => useclass( bless { a => 'b' }, 'Foo' ),
88 $struct->{foo} = 'bar';
89 is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
90 ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );
92 $struct->{hash1}->{foo} = 'bar';
93 is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
94 ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
98 my ($fh, $filename) = new_fh();
99 my $db = DBM::Deep->new({
102 type => DBM::Deep->TYPE_ARRAY,
109 { foo => [ 2 .. 4 ] },
112 $db->import( $struct );
119 useclass( bless( [], 'Bar' ) ),
120 { foo => [ 2 .. 4 ] },
122 "Everything matches",
125 push @$struct, 'bar';
126 is( $struct->[-1], 'bar', "\$struct has 'bar' at the end" );
127 ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" );
130 # Failure case to verify that rollback occurs
132 my ($fh, $filename) = new_fh();
133 my $db = DBM::Deep->new({
149 $db->import( $struct );
151 like( $@, qr/Storage of references of type 'SCALAR' is not supported/, 'Error message correct' );
154 local $TODO = "Importing cannot occur within a transaction yet.";
160 "Everything matches",
167 Need to add tests for:
168 - Failure case (have something tied or a glob or something like that)
169 - Where we already have $db->{hash1} to make sure that it's not overwritten