CURRENT/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