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(
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 );
54 $db->{blessed_long} = bless {}, 'a' x 1000;
58 my $db = DBM::Deep->new(
63 my $obj = $db->{blessed};
64 isa_ok( $obj, 'Foo' );
65 can_ok( $obj, 'export', 'foo' );
66 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
69 is( $obj->{b}[0], 1 );
70 is( $obj->{b}[1], 2 );
71 is( $obj->{b}[2], 3 );
73 my $obj2 = $db->{blessed2};
74 isa_ok( $obj, 'Foo' );
75 can_ok( $obj, 'export', 'foo' );
76 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
78 is( $obj2->[0]{a}, 'foo' );
79 is( $obj2->[1], '2' );
81 is( $db->{unblessed}{a}, 1 );
82 is( $db->{unblessed}{b}[0], 1 );
83 is( $db->{unblessed}{b}[1], 2 );
84 is( $db->{unblessed}{b}[2], 3 );
87 is( $db->{blessed}{c}, 'new' );
89 isa_ok( $db->{blessed_long}, 'a' x 1000 );
93 my $db = DBM::Deep->new(
97 is( $db->{blessed}{c}, 'new' );
99 my $structure = $db->export();
101 my $obj = $structure->{blessed};
102 isa_ok( $obj, 'Foo' );
103 can_ok( $obj, 'export', 'foo' );
104 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
107 is( $obj->{b}[0], 1 );
108 is( $obj->{b}[1], 2 );
109 is( $obj->{b}[2], 3 );
111 my $obj2 = $structure->{blessed2};
112 isa_ok( $obj, 'Foo' );
113 can_ok( $obj, 'export', 'foo' );
114 ok( !$obj->can( 'STORE' ), "... but it cannot 'STORE'" );
116 is( $obj2->[0]{a}, 'foo' );
117 is( $obj2->[1], '2' );
119 is( $structure->{unblessed}{a}, 1 );
120 is( $structure->{unblessed}{b}[0], 1 );
121 is( $structure->{unblessed}{b}[1], 2 );
122 is( $structure->{unblessed}{b}[2], 3 );
126 my $db = DBM::Deep->new(
131 my $obj = $db->{blessed};
132 isa_ok( $obj, 'DBM::Deep' );
133 can_ok( $obj, 'export', 'STORE' );
134 ok( !$obj->can( 'foo' ), "... but it cannot 'foo'" );
137 is( $obj->{b}[0], 1 );
138 is( $obj->{b}[1], 2 );
139 is( $obj->{b}[2], 3 );
141 my $obj2 = $db->{blessed2};
142 isa_ok( $obj2, 'DBM::Deep' );
143 can_ok( $obj2, 'export', 'STORE' );
144 ok( !$obj2->can( 'foo' ), "... but it cannot 'foo'" );
146 is( $obj2->[0]{a}, 'foo' );
147 is( $obj2->[1], '2' );
149 is( $db->{unblessed}{a}, 1 );
150 is( $db->{unblessed}{b}[0], 1 );
151 is( $db->{unblessed}{b}[1], 2 );
152 is( $db->{unblessed}{b}[2], 3 );
156 my ($fh2, $filename2) = new_fh();
158 my $db = DBM::Deep->new(
167 $db->import( { blessed => $obj } );
171 my $db = DBM::Deep->new(
176 my $blessed = $db->{blessed};
177 isa_ok( $blessed, 'Foo' );
178 is( $blessed->{a}, 1 );
184 # test blessing hash into short named class (Foo), then re-blessing into
185 # longer named class (FooFoo) and replacing key in db file, then validating
186 # content after that point in file to check for corruption.
188 my ($fh3, $filename3) = new_fh();
189 my $db = DBM::Deep->new(
194 my $obj = bless {}, 'Foo';
196 $db->{blessed} = $obj;
197 $db->{after} = "hello";
199 my $obj2 = bless {}, 'FooFoo';
201 $db->{blessed} = $obj2;
203 is( $db->{after}, "hello" );