t/18_export.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More;
   5 use Test::Deep;
   6 use t::common qw( new_dbm );
   7
   8 use_ok( 'DBM::Deep' );
   9
  10 my %struct = (
  11     key1 => "value1",
  12     key2 => "value2",
  13     array1 => [ "elem0", "elem1", "elem2", { foo => 'bar' }, [ 5 ] ],
  14     hash1 => {
  15         subkey1 => "subvalue1",
  16         subkey2 => "subvalue2",
  17         subkey3 => bless( {
  18             sub_obj => bless([
  19                 bless([], 'Foo'),
  20             ], 'Foo'),
  21             sub_obj2 => bless([], 'Foo'),
  22         }, 'Foo' ),
  23     },
  24 );
  25
  26 my $dbm_factory = new_dbm( autobless => 1 );
  27 while ( my $dbm_maker = $dbm_factory->() ) {
  28     my $db = $dbm_maker->();
  29
  30     ##
  31     # Create structure in DB
  32     ##
  33     $db->import( \%struct );
  34
  35     ##
  36     # Export entire thing
  37     ##
  38     my $compare = $db->export();
  39
  40     cmp_deeply(
  41         $compare,
  42         {
  43             key1 => "value1",
  44             key2 => "value2",
  45             array1 => [ "elem0", "elem1", "elem2", { foo => 'bar' }, [ 5 ] ],
  46             hash1 => {
  47                 subkey1 => "subvalue1",
  48                 subkey2 => "subvalue2",
  49                 subkey3 => bless( {
  50                     sub_obj => bless([
  51                         bless([], 'Foo'),
  52                     ], 'Foo'),
  53                     sub_obj2 => bless([], 'Foo'),
  54                 }, 'Foo' ),
  55             },
  56         },
  57         "Everything matches",
  58     );
  59
  60     isa_ok( tied(%{$db->{hash1}{subkey3}})->export, 'Foo' );
  61     isa_ok( tied(@{$db->{hash1}{subkey3}{sub_obj}})->export, 'Foo' );
  62     isa_ok( tied(@{$db->{hash1}{subkey3}{sub_obj}[0]})->export, 'Foo' );
  63     isa_ok( tied(@{$db->{hash1}{subkey3}{sub_obj2}})->export, 'Foo' );
  64 }
  65
  66 done_testing;