6 sub export { 'export' };
10 use Test::More tests => 54;
11 use File::Temp qw( tempfile tempdir );
13 use_ok( 'DBM::Deep' );
15 my $dir = tempdir( CLEANUP => 1 );
16 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
18 my $db = DBM::Deep->new(
28 $db->{blessed} = $obj;
34 $db->{blessed2} = $obj2;
36 $db->{unblessed} = {};
37 $db->{unblessed}{a} = 1;
38 $db->{unblessed}{b} = [];
39 $db->{unblessed}{b}[0] = 1;
40 $db->{unblessed}{b}[1] = 2;
41 $db->{unblessed}{b}[2] = 3;
45 my $db = DBM::Deep->new(
50 my $obj = $db->{blessed};
51 isa_ok( $obj, 'Foo' );
52 can_ok( $obj, 'export', 'foo' );
53 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
56 is( $obj->{b}[0], 1 );
57 is( $obj->{b}[1], 2 );
58 is( $obj->{b}[2], 3 );
60 my $obj2 = $db->{blessed2};
61 isa_ok( $obj, 'Foo' );
62 can_ok( $obj, 'export', 'foo' );
63 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
65 is( $obj2->[0]{a}, 'foo' );
66 is( $obj2->[1], '2' );
68 is( $db->{unblessed}{a}, 1 );
69 is( $db->{unblessed}{b}[0], 1 );
70 is( $db->{unblessed}{b}[1], 2 );
71 is( $db->{unblessed}{b}[2], 3 );
74 is( $db->{blessed}{c}, 'new' );
78 my $db = DBM::Deep->new(
82 is( $db->{blessed}{c}, 'new' );
84 my $structure = $db->export();
86 my $obj = $structure->{blessed};
87 isa_ok( $obj, 'Foo' );
88 can_ok( $obj, 'export', 'foo' );
89 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
92 is( $obj->{b}[0], 1 );
93 is( $obj->{b}[1], 2 );
94 is( $obj->{b}[2], 3 );
96 my $obj2 = $structure->{blessed2};
97 isa_ok( $obj, 'Foo' );
98 can_ok( $obj, 'export', 'foo' );
99 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
101 is( $obj2->[0]{a}, 'foo' );
102 is( $obj2->[1], '2' );
104 is( $structure->{unblessed}{a}, 1 );
105 is( $structure->{unblessed}{b}[0], 1 );
106 is( $structure->{unblessed}{b}[1], 2 );
107 is( $structure->{unblessed}{b}[2], 3 );
111 my $db = DBM::Deep->new(
115 my $obj = $db->{blessed};
116 isa_ok( $obj, 'DBM::Deep' );
117 can_ok( $obj, 'export', 'STORE' );
118 ok( !$obj->can( 'foo' ), "... but it cannot 'foo'" );
121 is( $obj->{b}[0], 1 );
122 is( $obj->{b}[1], 2 );
123 is( $obj->{b}[2], 3 );
125 my $obj2 = $db->{blessed2};
126 isa_ok( $obj2, 'DBM::Deep' );
127 can_ok( $obj2, 'export', 'STORE' );
128 ok( !$obj2->can( 'foo' ), "... but it cannot 'foo'" );
130 is( $obj2->[0]{a}, 'foo' );
131 is( $obj2->[1], '2' );
133 is( $db->{unblessed}{a}, 1 );
134 is( $db->{unblessed}{b}[0], 1 );
135 is( $db->{unblessed}{b}[1], 2 );
136 is( $db->{unblessed}{b}[2], 3 );
139 my ($fh2, $filename2) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
141 my $db = DBM::Deep->new(
150 $db->import( { blessed => $obj } );
154 my $db = DBM::Deep->new(
159 my $blessed = $db->{blessed};
160 isa_ok( $blessed, 'Foo' );
161 is( $blessed->{a}, 1 );
166 # test blessing hash into short named class (Foo), then re-blessing into
167 # longer named class (FooFoo) and replacing key in db file, then validating
168 # content after that point in file to check for corruption.
170 my ($fh3, $filename3) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
171 my $db = DBM::Deep->new(
176 my $obj = bless {}, 'Foo';
178 $db->{blessed} = $obj;
179 $db->{after} = "hello";
181 my $obj2 = bless {}, 'FooFoo';
183 $db->{blessed} = $obj2;
185 is( $db->{after}, "hello" );