t/17_import.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 11;
   6 use Test::Deep;
   7 use t::common qw( new_fh );
   8
   9 use_ok( 'DBM::Deep' );
  10
  11 {
  12     my ($fh, $filename) = new_fh();
  13     my $db = DBM::Deep->new({
  14         file      => $filename,
  15         autobless => 1,
  16     });
  17
  18 ##
  19 # Create structure in memory
  20 ##
  21     my $struct = {
  22         key1 => "value1",
  23         key2 => "value2",
  24         array1 => [ "elem0", "elem1", "elem2" ],
  25         hash1 => {
  26             subkey1 => "subvalue1",
  27             subkey2 => "subvalue2",
  28             subkey3 => bless( {}, 'Foo' ),
  29         }
  30     };
  31
  32     $db->import( $struct );
  33
  34     cmp_deeply(
  35         $db,
  36         noclass({
  37             key1 => 'value1',
  38             key2 => 'value2',
  39             array1 => [ 'elem0', 'elem1', 'elem2', ],
  40             hash1 => {
  41                 subkey1 => "subvalue1",
  42                 subkey2 => "subvalue2",
  43                 subkey3 => useclass( bless {}, 'Foo' ),
  44             },
  45         }),
  46         "Everything matches",
  47     );
  48
  49     $struct->{foo} = 'bar';
  50     is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
  51     ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );
  52
  53     $struct->{hash1}->{foo} = 'bar';
  54     is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
  55     ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
  56 }
  57
  58 {
  59     my ($fh, $filename) = new_fh();
  60     my $db = DBM::Deep->new({
  61         file => $filename,
  62         type => DBM::Deep->TYPE_ARRAY,
  63     });
  64
  65     my $struct = [
  66         1 .. 3,
  67         [ 2, 4, 6 ],
  68         bless( [], 'Bar' ),
  69         { foo => [ 2 .. 4 ] },
  70     ];
  71
  72     $db->import( $struct );
  73
  74     cmp_deeply(
  75         $db,
  76         noclass([
  77             1 .. 3,
  78             [ 2, 4, 6 ],
  79             useclass( bless( [], 'Bar' ) ),
  80             { foo => [ 2 .. 4 ] },
  81         ]),
  82         "Everything matches",
  83     );
  84
  85     push @$struct, 'bar';
  86     is( $struct->[-1], 'bar', "\$struct has 'bar' at the end" );
  87     ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" );
  88 }
  89
  90 # Failure case to verify that rollback occurs
  91 {
  92     my ($fh, $filename) = new_fh();
  93     my $db = DBM::Deep->new({
  94         file      => $filename,
  95         autobless => 1,
  96     });
  97
  98     $db->{foo} = 'bar';
  99
 100     my $x;
 101     my $struct = {
 102         key1 => [
 103             2, \$x, 3,
 104         ],
 105     };
 106
 107     eval {
 108         $db->import( $struct );
 109     };
 110     like( $@, qr/Storage of references of type 'SCALAR' is not supported/, 'Error message correct' );
 111
 112     TODO: {
 113         local $TODO = "Importing cannot occur within a transaction yet.";
 114         cmp_deeply(
 115             $db,
 116             noclass({
 117                 foo => 'bar',
 118             }),
 119             "Everything matches",
 120         );
 121     }
 122 }
 123
 124 __END__
 125
 126 Need to add tests for:
 127     - Failure case (have something tied or a glob or something like that)
 128     - Where we already have $db->{hash1} to make sure that it's not overwritten