6 sub export { 'export' };
10 use Test::More tests => 54;
12 use_ok( 'DBM::Deep' );
16 my $db = DBM::Deep->new(
26 $db->{blessed} = $obj;
32 $db->{blessed2} = $obj2;
34 $db->{unblessed} = {};
35 $db->{unblessed}{a} = 1;
36 $db->{unblessed}{b} = [];
37 $db->{unblessed}{b}[0] = 1;
38 $db->{unblessed}{b}[1] = 2;
39 $db->{unblessed}{b}[2] = 3;
43 my $db = DBM::Deep->new(
48 my $obj = $db->{blessed};
49 isa_ok( $obj, 'Foo' );
50 can_ok( $obj, 'export', 'foo' );
51 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
54 is( $obj->{b}[0], 1 );
55 is( $obj->{b}[1], 2 );
56 is( $obj->{b}[2], 3 );
58 my $obj2 = $db->{blessed2};
59 isa_ok( $obj, 'Foo' );
60 can_ok( $obj, 'export', 'foo' );
61 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
63 is( $obj2->[0]{a}, 'foo' );
64 is( $obj2->[1], '2' );
66 is( $db->{unblessed}{a}, 1 );
67 is( $db->{unblessed}{b}[0], 1 );
68 is( $db->{unblessed}{b}[1], 2 );
69 is( $db->{unblessed}{b}[2], 3 );
72 is( $db->{blessed}{c}, 'new' );
76 my $db = DBM::Deep->new(
80 is( $db->{blessed}{c}, 'new' );
82 my $structure = $db->export();
84 my $obj = $structure->{blessed};
85 isa_ok( $obj, 'Foo' );
86 can_ok( $obj, 'export', 'foo' );
87 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
90 is( $obj->{b}[0], 1 );
91 is( $obj->{b}[1], 2 );
92 is( $obj->{b}[2], 3 );
94 my $obj2 = $structure->{blessed2};
95 isa_ok( $obj, 'Foo' );
96 can_ok( $obj, 'export', 'foo' );
97 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
99 is( $obj2->[0]{a}, 'foo' );
100 is( $obj2->[1], '2' );
102 is( $structure->{unblessed}{a}, 1 );
103 is( $structure->{unblessed}{b}[0], 1 );
104 is( $structure->{unblessed}{b}[1], 2 );
105 is( $structure->{unblessed}{b}[2], 3 );
109 my $db = DBM::Deep->new(
113 my $obj = $db->{blessed};
114 isa_ok( $obj, 'DBM::Deep' );
115 can_ok( $obj, 'export', 'STORE' );
116 ok( !$obj->can( 'foo' ), "... but it cannot 'foo'" );
119 is( $obj->{b}[0], 1 );
120 is( $obj->{b}[1], 2 );
121 is( $obj->{b}[2], 3 );
123 my $obj2 = $db->{blessed2};
124 isa_ok( $obj2, 'DBM::Deep' );
125 can_ok( $obj2, 'export', 'STORE' );
126 ok( !$obj2->can( 'foo' ), "... but it cannot 'foo'" );
128 is( $obj2->[0]{a}, 'foo' );
129 is( $obj2->[1], '2' );
131 is( $db->{unblessed}{a}, 1 );
132 is( $db->{unblessed}{b}[0], 1 );
133 is( $db->{unblessed}{b}[1], 2 );
134 is( $db->{unblessed}{b}[2], 3 );
139 my $db = DBM::Deep->new(
140 file => "t/test2.db",
148 $db->import( { blessed => $obj } );
152 $db = DBM::Deep->new(
153 file => "t/test2.db",
157 my $blessed = $db->{blessed};
158 isa_ok( $blessed, 'Foo' );
159 is( $blessed->{a}, 1 );
164 # test blessing hash into short named class (Foo), then re-blessing into
165 # longer named class (FooFoo) and replacing key in db file, then validating
166 # content after that point in file to check for corruption.
169 my $db = DBM::Deep->new(
170 file => "t/test3.db",
174 my $obj = bless {}, 'Foo';
176 $db->{blessed} = $obj;
177 $db->{after} = "hello";
179 my $obj2 = bless {}, 'FooFoo';
181 $db->{blessed} = $obj2;
183 is( $db->{after}, "hello" );