1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use KiokuDB;
use KiokuDB::Backend::Hash;
{
package KiokuDB_Test_Blah;
sub new {
my $class = shift;
bless {@_}, $class;
}
sub data { $_[0]{data} }
package KiokuDB_Test_Foo;
use base qw(KiokuDB_Test_Blah);
package KiokuDB_Test_Bar;
use base qw(KiokuDB_Test_Foo);
package KiokuDB_Test_Baz;
use base qw(KiokuDB_Test_Blah);
package KiokuDB_Test_Qux;
use base qw(KiokuDB_Test_Baz);
package KiokuDB_Test_Person;
use Moose;
has name => ( is => "rw" );
}
use constant HAVE_CA => eval { require Class::Accessor };
use constant HAVE_OT => eval { require Object::Tiny };
use constant HAVE_OI => eval { require Object::InsideOut };
if ( HAVE_CA ) {
eval q{
package KiokuDB_Test_CA::KiokuDB_Test_Foo;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(data));
};
}
if ( HAVE_OT ) {
eval q{
package KiokuDB_Test_OT::KiokuDB_Test_Foo;
use Object::Tiny qw(data);
}
}
if ( HAVE_OI ) {
eval q{
package KiokuDB_Test_OI::KiokuDB_Test_Foo;
use Object::InsideOut;
my @data :Field :Accessor(data) :Arg(Name => 'data');
}
}
foreach my $format ( qw(storable json yaml) ) {
foreach my $data ( "foo", 42, [ 1 .. 3 ], { foo => "bar" }, KiokuDB_Test_Person->new( name => "jello" ) ) {
my $dir = KiokuDB->connect( hash => (
serializer => $format,
allow_classes => [qw(KiokuDB_Test_Foo)],
allow_bases => [qw(KiokuDB_Test_Baz)],
allow_class_builders => 1,
));
{
my $s = $dir->new_scope;
lives_ok { $dir->store( foo => KiokuDB_Test_Foo->new( data => $data ) ) } "can store foo";
dies_ok { $dir->store( bar => KiokuDB_Test_Bar->new( data => $data ) ) } "can't store bar";
lives_ok { $dir->store( baz => KiokuDB_Test_Baz->new( data => $data ) ) } "can store baz";
lives_ok { $dir->store( qux => KiokuDB_Test_Qux->new( data => $data ) ) } "can store qux";
}
{
my $s = $dir->new_scope;
is_deeply( $dir->lookup("foo"), KiokuDB_Test_Foo->new( data => $data ), "lookup foo" );
is_deeply( $dir->lookup("baz"), KiokuDB_Test_Baz->new( data => $data ), "lookup baz" );
is_deeply( $dir->lookup("qux"), KiokuDB_Test_Qux->new( data => $data ), "lookup qux" );
ok( !$dir->exists("bar"), "bar doesn't exist" );
}
if ( HAVE_CA ) {
{
my $s = $dir->new_scope;
lives_ok { $dir->store( ca => KiokuDB_Test_CA::KiokuDB_Test_Foo->new({ data => $data }) ) } "can store Class::Accessor";
}
{
my $s = $dir->new_scope;
is_deeply( $dir->lookup("ca"), KiokuDB_Test_CA::KiokuDB_Test_Foo->new({ data => $data }), "is_deeply" );
}
}
if ( HAVE_OT ) {
{
my $s = $dir->new_scope;
lives_ok { $dir->store( ot => KiokuDB_Test_OT::KiokuDB_Test_Foo->new( data => $data ) ) } "can store Object::Tiny";
}
{
my $s = $dir->new_scope;
is_deeply( $dir->lookup("ot"), KiokuDB_Test_OT::KiokuDB_Test_Foo->new( data => $data ), "is_deeply" );
}
}
if ( HAVE_OI ) {
{
my $s = $dir->new_scope;
lives_ok { $dir->store( oi => KiokuDB_Test_OI::KiokuDB_Test_Foo->new( data => $data ) ) } "can store Object::InsideOut";
}
{
my $s = $dir->new_scope;
is_deeply( $dir->lookup("oi")->dump, KiokuDB_Test_OI::KiokuDB_Test_Foo->new( data => $data )->dump, "is_deeply" );
}
}
}
}
done_testing;
|
