6 sub export { 'export' };
10 use Test::More tests => 65;
11 use t::common qw( new_fh );
13 use_ok( 'DBM::Deep' );
15 my ($fh, $filename) = new_fh();
17 my $db = DBM::Deep->new(
28 $db->{blessed} = $obj;
29 is( $db->{blessed}{a}, 1 );
30 is( $db->{blessed}{b}[0], 1 );
31 is( $db->{blessed}{b}[1], 2 );
32 is( $db->{blessed}{b}[2], 3 );
38 $db->{blessed2} = $obj2;
40 is( $db->{blessed2}[0]{a}, 'foo' );
41 is( $db->{blessed2}[1], '2' );
43 $db->{unblessed} = {};
44 $db->{unblessed}{a} = 1;
45 $db->{unblessed}{b} = [];
46 $db->{unblessed}{b}[0] = 1;
47 $db->{unblessed}{b}[1] = 2;
48 $db->{unblessed}{b}[2] = 3;
50 is( $db->{unblessed}{a}, 1 );
51 is( $db->{unblessed}{b}[0], 1 );
52 is( $db->{unblessed}{b}[1], 2 );
53 is( $db->{unblessed}{b}[2], 3 );
55 $db->{blessed_long} = bless {}, 'a' x 1000;
56 $db->_get_self->_storage->close( $db->_get_self );
60 my $db = DBM::Deep->new(
65 my $obj = $db->{blessed};
66 isa_ok( $obj, 'Foo' );
67 can_ok( $obj, 'export', 'foo' );
68 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
71 is( $obj->{b}[0], 1 );
72 is( $obj->{b}[1], 2 );
73 is( $obj->{b}[2], 3 );
75 my $obj2 = $db->{blessed2};
76 isa_ok( $obj2, 'Foo' );
77 can_ok( $obj2, 'export', 'foo' );
78 ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
80 is( $obj2->[0]{a}, 'foo' );
81 is( $obj2->[1], '2' );
83 is( $db->{unblessed}{a}, 1 );
84 is( $db->{unblessed}{b}[0], 1 );
85 is( $db->{unblessed}{b}[1], 2 );
86 is( $db->{unblessed}{b}[2], 3 );
89 is( $db->{blessed}{c}, 'new' );
91 isa_ok( $db->{blessed_long}, 'a' x 1000 );
92 $db->_get_self->_storage->close( $db->_get_self );
96 my $db = DBM::Deep->new(
100 is( $db->{blessed}{c}, 'new' );
102 my $structure = $db->export();
103 use Data::Dumper;print Dumper $structure;
105 my $obj = $structure->{blessed};
106 isa_ok( $obj, 'Foo' );
107 can_ok( $obj, 'export', 'foo' );
108 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
111 is( $obj->{b}[0], 1 );
112 is( $obj->{b}[1], 2 );
113 is( $obj->{b}[2], 3 );
115 my $obj2 = $structure->{blessed2};
116 isa_ok( $obj2, 'Foo' );
117 can_ok( $obj2, 'export', 'foo' );
118 ok( !$obj2->can( 'STORE' ), "... but it cannot 'STORE'" );
120 is( $obj2->[0]{a}, 'foo' );
121 is( $obj2->[1], '2' );
123 is( $structure->{unblessed}{a}, 1 );
124 is( $structure->{unblessed}{b}[0], 1 );
125 is( $structure->{unblessed}{b}[1], 2 );
126 is( $structure->{unblessed}{b}[2], 3 );
127 $db->_get_self->_storage->close( $db->_get_self );
131 my $db = DBM::Deep->new(
136 my $obj = $db->{blessed};
137 isa_ok( $obj, 'DBM::Deep' );
138 can_ok( $obj, 'export', 'STORE' );
139 ok( !$obj->can( 'foo' ), "... but it cannot 'foo'" );
142 is( $obj->{b}[0], 1 );
143 is( $obj->{b}[1], 2 );
144 is( $obj->{b}[2], 3 );
146 my $obj2 = $db->{blessed2};
147 isa_ok( $obj2, 'DBM::Deep' );
148 can_ok( $obj2, 'export', 'STORE' );
149 ok( !$obj2->can( 'foo' ), "... but it cannot 'foo'" );
151 is( $obj2->[0]{a}, 'foo' );
152 is( $obj2->[1], '2' );
154 is( $db->{unblessed}{a}, 1 );
155 is( $db->{unblessed}{b}[0], 1 );
156 is( $db->{unblessed}{b}[1], 2 );
157 is( $db->{unblessed}{b}[2], 3 );
158 $db->_get_self->_storage->close( $db->_get_self );
162 my ($fh2, $filename2) = new_fh();
164 my $db = DBM::Deep->new(
174 $db->import( { blessed => $obj } );
175 $db->_get_self->_storage->close( $db->_get_self );
179 my $db = DBM::Deep->new(
184 my $blessed = $db->{blessed};
185 isa_ok( $blessed, 'Foo' );
186 is( $blessed->{a}, 1 );
187 $db->_get_self->_storage->close( $db->_get_self );
193 # test blessing hash into short named class (Foo), then re-blessing into
194 # longer named class (FooFoo) and replacing key in db file, then validating
195 # content after that point in file to check for corruption.
197 my ($fh3, $filename3) = new_fh();
198 my $db = DBM::Deep->new(
204 my $obj = bless {}, 'Foo';
206 $db->{blessed} = $obj;
207 $db->{after} = "hello";
209 my $obj2 = bless {}, 'FooFoo';
211 $db->{blessed} = $obj2;
213 is( $db->{after}, "hello" );