Fixing things around
[dbsrgits/DBM-Deep.git] / t / 17_import.t
1 ##
2 # DBM::Deep Test
3 ##
4 use strict;
5 use Test::More tests => 6;
6 use Test::Deep;
7 use t::common qw( new_fh );
8
9 use_ok( 'DBM::Deep' );
10
11 my ($fh, $filename) = new_fh();
12 my $db = DBM::Deep->new({
13     file      => $filename,
14     autobless => 1,
15 });
16
17 ##
18 # Create structure in memory
19 ##
20 my $struct = {
21         key1 => "value1",
22         key2 => "value2",
23         array1 => [ "elem0", "elem1", "elem2" ],
24         hash1 => {
25                 subkey1 => "subvalue1",
26                 subkey2 => "subvalue2",
27         subkey3 => bless( {}, 'Foo' ),
28         }
29 };
30
31 ##
32 # Import entire thing
33 ##
34 $db->import( $struct );
35
36 cmp_deeply(
37     $db,
38     noclass({
39         key1 => 'value1',
40         key2 => 'value2',
41         array1 => [ 'elem0', 'elem1', 'elem2', ],
42         hash1 => {
43             subkey1 => "subvalue1",
44             subkey2 => "subvalue2",
45             subkey3 => useclass( bless {}, 'Foo' ),
46         },
47     }),
48     "Everything matches",
49 );
50
51 $struct->{foo} = 'bar';
52 is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
53 ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );
54
55 $struct->{hash1}->{foo} = 'bar';
56 is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
57 ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
58
59 __END__
60
61 Need to add tests for:
62     - Failure case (have something tied or a glob or something like that)
63     - Where we already have $db->{hash1} to make sure that it's not overwritten