6 sub export { 'export' };
10 use Test::More tests => 39;
12 use_ok( 'DBM::Deep' );
15 my $db = DBM::Deep->new(
20 die "ERROR: " . $db->error();
28 $db->{blessed} = $obj;
30 $db->{unblessed} = {};
31 $db->{unblessed}{a} = 1;
32 $db->{unblessed}{b} = [];
33 $db->{unblessed}{b}[0] = 1;
34 $db->{unblessed}{b}[1] = 2;
35 $db->{unblessed}{b}[2] = 3;
39 my $db2 = DBM::Deep->new(
44 die "ERROR: " . $db2->error();
47 my $obj2 = $db2->{blessed};
48 isa_ok( $obj2, 'Foo' );
49 can_ok( $obj2, 'export', 'foo' );
50 ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
53 is( $obj2->{b}[0], 1 );
54 is( $obj2->{b}[1], 2 );
55 is( $obj2->{b}[2], 3 );
57 is( $db2->{unblessed}{a}, 1 );
58 is( $db2->{unblessed}{b}[0], 1 );
59 is( $db2->{unblessed}{b}[1], 2 );
60 is( $db2->{unblessed}{b}[2], 3 );
63 is( $db2->{blessed}{c}, 'new' );
67 $db2 = DBM::Deep->new(
71 is( $db2->{blessed}{c}, 'new' );
74 my $structure = $db2->export();
76 my $obj2 = $structure->{blessed};
77 isa_ok( $obj2, 'Foo' );
78 can_ok( $obj2, 'export', 'foo' );
79 ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
82 is( $obj2->{b}[0], 1 );
83 is( $obj2->{b}[1], 2 );
84 is( $obj2->{b}[2], 3 );
86 is( $structure->{unblessed}{a}, 1 );
87 is( $structure->{unblessed}{b}[0], 1 );
88 is( $structure->{unblessed}{b}[1], 2 );
89 is( $structure->{unblessed}{b}[2], 3 );
92 my $db3 = DBM::Deep->new(
96 die "ERROR: " . $db3->error();
99 my $obj3 = $db3->{blessed};
100 isa_ok( $obj3, 'DBM::Deep' );
101 can_ok( $obj3, 'export', 'STORE' );
102 ok( !$obj3->can( 'foo' ), "... but it cannot 'foo'" );
105 is( $obj3->{b}[0], 1 );
106 is( $obj3->{b}[1], 2 );
107 is( $obj3->{b}[2], 3 );
109 is( $db3->{unblessed}{a}, 1 );
110 is( $db3->{unblessed}{b}[0], 1 );
111 is( $db3->{unblessed}{b}[1], 2 );
112 is( $db3->{unblessed}{b}[2], 3 );
120 my $db = DBM::Deep->new(
121 file => "t/test2.db",
125 die "ERROR: " . $db->error();
132 $db->import( { blessed => $obj } );
136 $db = DBM::Deep->new(
137 file => "t/test2.db",
141 die "ERROR: " . $db->error();
144 my $blessed = $db->{blessed};
145 isa_ok( $blessed, 'Foo' );
146 is( $blessed->{a}, 1 );
151 # test blessing hash into short named class (Foo), then re-blessing into
152 # longer named class (FooFoo) and replacing key in db file, then validating
153 # content after that point in file to check for corruption.
156 my $db = DBM::Deep->new(
157 file => "t/test3.db",
161 die "ERROR: " . $db->error();
164 my $obj = bless {}, 'Foo';
166 $db->{blessed} = $obj;
167 $db->{after} = "hello";
169 my $obj2 = bless {}, 'FooFoo';
171 $db->{blessed} = $obj2;
173 is( $db->{after}, "hello" );