6 sub export { 'export' };
10 use Test::More tests => 64;
11 use t::common qw( new_fh );
13 use_ok( 'DBM::Deep' );
15 my ($fh, $filename) = new_fh();
17 my $db = DBM::Deep->new(
27 $db->{blessed} = $obj;
28 is( $db->{blessed}{a}, 1 );
29 is( $db->{blessed}{b}[0], 1 );
30 is( $db->{blessed}{b}[1], 2 );
31 is( $db->{blessed}{b}[2], 3 );
37 $db->{blessed2} = $obj2;
39 is( $db->{blessed2}[0]{a}, 'foo' );
40 is( $db->{blessed2}[1], '2' );
42 $db->{unblessed} = {};
43 $db->{unblessed}{a} = 1;
44 $db->{unblessed}{b} = [];
45 $db->{unblessed}{b}[0] = 1;
46 $db->{unblessed}{b}[1] = 2;
47 $db->{unblessed}{b}[2] = 3;
49 is( $db->{unblessed}{a}, 1 );
50 is( $db->{unblessed}{b}[0], 1 );
51 is( $db->{unblessed}{b}[1], 2 );
52 is( $db->{unblessed}{b}[2], 3 );
56 my $db = DBM::Deep->new(
61 my $obj = $db->{blessed};
62 isa_ok( $obj, 'Foo' );
63 can_ok( $obj, 'export', 'foo' );
64 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
67 is( $obj->{b}[0], 1 );
68 is( $obj->{b}[1], 2 );
69 is( $obj->{b}[2], 3 );
71 my $obj2 = $db->{blessed2};
72 isa_ok( $obj, 'Foo' );
73 can_ok( $obj, 'export', 'foo' );
74 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
76 is( $obj2->[0]{a}, 'foo' );
77 is( $obj2->[1], '2' );
79 is( $db->{unblessed}{a}, 1 );
80 is( $db->{unblessed}{b}[0], 1 );
81 is( $db->{unblessed}{b}[1], 2 );
82 is( $db->{unblessed}{b}[2], 3 );
85 is( $db->{blessed}{c}, 'new' );
89 my $db = DBM::Deep->new(
93 is( $db->{blessed}{c}, 'new' );
95 my $structure = $db->export();
97 my $obj = $structure->{blessed};
98 isa_ok( $obj, 'Foo' );
99 can_ok( $obj, 'export', 'foo' );
100 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
103 is( $obj->{b}[0], 1 );
104 is( $obj->{b}[1], 2 );
105 is( $obj->{b}[2], 3 );
107 my $obj2 = $structure->{blessed2};
108 isa_ok( $obj, 'Foo' );
109 can_ok( $obj, 'export', 'foo' );
110 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
112 is( $obj2->[0]{a}, 'foo' );
113 is( $obj2->[1], '2' );
115 is( $structure->{unblessed}{a}, 1 );
116 is( $structure->{unblessed}{b}[0], 1 );
117 is( $structure->{unblessed}{b}[1], 2 );
118 is( $structure->{unblessed}{b}[2], 3 );
122 my $db = DBM::Deep->new(
127 my $obj = $db->{blessed};
128 isa_ok( $obj, 'DBM::Deep' );
129 can_ok( $obj, 'export', 'STORE' );
130 ok( !$obj->can( 'foo' ), "... but it cannot 'foo'" );
133 is( $obj->{b}[0], 1 );
134 is( $obj->{b}[1], 2 );
135 is( $obj->{b}[2], 3 );
137 my $obj2 = $db->{blessed2};
138 isa_ok( $obj2, 'DBM::Deep' );
139 can_ok( $obj2, 'export', 'STORE' );
140 ok( !$obj2->can( 'foo' ), "... but it cannot 'foo'" );
142 is( $obj2->[0]{a}, 'foo' );
143 is( $obj2->[1], '2' );
145 is( $db->{unblessed}{a}, 1 );
146 is( $db->{unblessed}{b}[0], 1 );
147 is( $db->{unblessed}{b}[1], 2 );
148 is( $db->{unblessed}{b}[2], 3 );
151 my ($fh2, $filename2) = new_fh();
153 my $db = DBM::Deep->new(
162 $db->import( { blessed => $obj } );
166 my $db = DBM::Deep->new(
171 my $blessed = $db->{blessed};
172 isa_ok( $blessed, 'Foo' );
173 is( $blessed->{a}, 1 );
178 # test blessing hash into short named class (Foo), then re-blessing into
179 # longer named class (FooFoo) and replacing key in db file, then validating
180 # content after that point in file to check for corruption.
182 my ($fh3, $filename3) = new_fh();
183 my $db = DBM::Deep->new(
188 my $obj = bless {}, 'Foo';
190 $db->{blessed} = $obj;
191 $db->{after} = "hello";
193 my $obj2 = bless {}, 'FooFoo';
195 $db->{blessed} = $obj2;
197 is( $db->{after}, "hello" );