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
|
#!/usr/bin/env perl
use strict;
use warnings;
use Scalar::Util qw(refaddr);
use Test::More;use Test::Exception;
use Test::TempDir;
use KiokuDB;
use Test::Requires 'DBD::SQLite';
use DBIx::Class::Optional::Dependencies;
my $deploy_deps;
BEGIN {
$deploy_deps = DBIx::Class::Optional::Dependencies->req_list_for('deploy');
}
use Test::Requires $deploy_deps;
{
package MyApp::DB::Result::Gaplonk; # Acme::MetaSyntacic::donmartin ++
use base qw(DBIx::Class::Core);
__PACKAGE__->load_components(qw(KiokuDB));
__PACKAGE__->table('gaplonk');
__PACKAGE__->add_columns(qw(id name object));
__PACKAGE__->set_primary_key('id');
__PACKAGE__->kiokudb_column('object');
package MyApp::DB;
use base qw(DBIx::Class::Schema);
__PACKAGE__->load_components(qw(Schema::KiokuDB));
__PACKAGE__->define_kiokudb_schema();
__PACKAGE__->register_class( Gaplonk => qw(MyApp::DB::Result::Gaplonk));
package Patawee;
use Moose;
has sproing => ( isa => "Str", is => "ro" );
__PACKAGE__->meta->make_immutable;
}
my $sqlite = "dbi:SQLite:dbname=" . temp_root->file("db");
my $schema = MyApp::DB->connect($sqlite);
{
my $refaddr;
{
isa_ok( my $k = $schema->kiokudb_handle, "KiokuDB" );
$refaddr = refaddr($k);
}
{
is( refaddr($schema->kiokudb_handle), $refaddr, "KiokuDB handle not weak when autovivified" );
}
}
my $dir = $schema->kiokudb_handle;
isa_ok( $dir, 'KiokuDB', 'got autovived directory handle from schema');
$dir->backend->deploy;
my $id;
lives_ok {
$dir->txn_do( scope => 1, body => sub {
my $object = Patawee->new( sproing=> 'kalloon' );
my $thing = $schema->resultset('Gaplonk')->create({
id => 1,
name =>'VOOMAROOMA',
object => $object
});
$id = $thing->id;
});
} 'create row in DB';
$dir->txn_do( scope => 1, body => sub {
my $fetch_again = $schema->resultset('Gaplonk')->find( $id );
isa_ok( $fetch_again, 'MyApp::DB::Result::Gaplonk', 'got DBIC row object back' );
is($fetch_again->name,'VOOMAROOMA','row->name');
my $object = $fetch_again->object;
isa_ok( $object, 'Patawee' );
is( $object->sproing, 'kalloon', 'object attribute' );
});
done_testing();
|
