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({
23 } qr/Cannot import a scalar/, "Importing a scalar to type '$type' fails";
25 # Load a ref of the wrong type
26 # Load something with bad stuff in it
30 $db->import( { foo => 'bar' } );
31 } qr/Cannot import a hash into an array/, "Wrong type fails";
34 $db->import( [ \$x ] );
35 } qr/Storage of references of type 'SCALAR' is not supported/, "Bad stuff fails";
39 $db->import( [ 1 .. 3 ] );
40 } qr/Cannot import an array into a hash/, "Wrong type fails";
43 $db->import( { foo => \$x } );
44 } qr/Storage of references of type 'SCALAR' is not supported/, "Bad stuff fails";
49 my ($fh, $filename) = new_fh();
50 my $db = DBM::Deep->new({
56 # Create structure in memory
61 array1 => [ "elem0", "elem1", "elem2" ],
63 subkey1 => "subvalue1",
64 subkey2 => "subvalue2",
65 subkey3 => bless( { a => 'b' }, 'Foo' ),
69 $db->import( $struct );
76 array1 => [ 'elem0', 'elem1', 'elem2', ],
78 subkey1 => "subvalue1",
79 subkey2 => "subvalue2",
80 subkey3 => useclass( bless { a => 'b' }, 'Foo' ),
86 $struct->{foo} = 'bar';
87 is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
88 ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );
90 $struct->{hash1}->{foo} = 'bar';
91 is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
92 ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
96 my ($fh, $filename) = new_fh();
97 my $db = DBM::Deep->new({
99 type => DBM::Deep->TYPE_ARRAY,
106 { foo => [ 2 .. 4 ] },
109 $db->import( $struct );
116 useclass( bless( [], 'Bar' ) ),
117 { foo => [ 2 .. 4 ] },
119 "Everything matches",
122 push @$struct, 'bar';
123 is( $struct->[-1], 'bar', "\$struct has 'bar' at the end" );
124 ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" );
127 # Failure case to verify that rollback occurs
129 my ($fh, $filename) = new_fh();
130 my $db = DBM::Deep->new({
145 $db->import( $struct );
147 like( $@, qr/Storage of references of type 'SCALAR' is not supported/, 'Error message correct' );
150 local $TODO = "Importing cannot occur within a transaction yet.";
156 "Everything matches",
163 Need to add tests for:
164 - Failure case (have something tied or a glob or something like that)
165 - Where we already have $db->{hash1} to make sure that it's not overwritten