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
135
136
137
|
use Test::More tests => 18;
use Test::Exception;
use DBI;
use PGObject 'test1', 'test2';
ok(PGObject::Type::Registry->inspect('test1'), 'test1 registry exists');
ok(PGObject::Type::Registry->inspect('test2'), 'test2 registry exists');
lives_ok {PGObject->new_registry('test1') } 'New registry 1 recreation lives';
lives_ok {PGObject->new_registry('blank') } 'New registry blank created';
lives_ok {PGObject->new_registry('test2') } 'New registry 2 recreation lives';
is(PGObject->register_type(pg_type => 'int4', perl_class => 'test1'), 1,
"Basic type registration");
is(PGObject->register_type(
pg_type => 'int4', perl_class => 'test2', registry => 'test1'), 1,
"Basic type registration");
SKIP: {
skip 'No database connection', 11 unless $ENV{DB_TESTING};
# Initial db setup
my $dbh1 = DBI->connect('dbi:Pg:', 'postgres') ;
$dbh1->do('CREATE DATABASE pgobject_test_db') if $dbh1;
my $dbh = DBI->connect('dbi:Pg:dbname=pgobject_test_db', 'postgres') if $dbh1;
$dbh->{pg_server_prepare} = 0 if $dbh;
# Functions to test.
$dbh->do('
CREATE OR REPLACE FUNCTION test_serialarray(int[]) returns int[] language sql as $$
SELECT $1;
$$') if $dbh;
$dbh->do('
CREATE OR REPLACE FUNCTION test_serialization(int) returns int language sql as $$
SELECT $1;
$$') if $dbh;
$dbh->do('
CREATE OR REPLACE FUNCTION test_int() returns int language sql as $$
SELECT 1000;
$$') if $dbh;
$dbh->do('
CREATE OR REPLACE FUNCTION test_ints() returns int[] language sql as $$
SELECT array[1000::int, 100, 10];
$$') if $dbh;
my ($result) = PGObject->call_procedure(
funcname => 'test_int',
args => [],
dbh => $dbh,
);
is($result->{test_int}, 4, 'Correct handling of override, default registry');
($result) = PGObject->call_procedure(
funcname => 'test_int',
args => [],
dbh => $dbh,
registry => 'test1',
);
is($result->{test_int}, 8, 'Correct handling of override, named registry');
ok(($result) = PGObject->call_procedure(
funcname => 'test_ints',
args => [],
dbh => $dbh,
));
for (0 .. 2) {
is $result->{test_ints}->[$_], 4, "Array element $_ handled by registered type";
}
($result) = PGObject->call_procedure(
funcname => 'test_int',
args => [],
dbh => $dbh,
registry => 'test2',
);
is($result->{test_int}, 1000,
'Correct handling of override, named registry with no override');
my $test = bless {}, 'test1';
ok(($result) = PGObject->call_procedure(
funcname => 'test_serialization',
dbh => $dbh,
args => [$test],
registry => 'blank',
), 'called test_serialization correctly');
is($result->{test_serialization}, 8, 'serialized to db correctly');
ok(($result) = PGObject->call_procedure(
funcname => 'test_serialarray',
dbh => $dbh,
args => [[$test]],
registry => 'blank',
), 'called test_serialization correctly');
is($result->{test_serialarray}->[0], 8, 'serialized to db correctly');
$dbh->disconnect if $dbh;
$dbh1->do('DROP DATABASE pgobject_test_db') if $dbh1;
$dbh1->disconnect if $dbh1;
}
package test1;
sub from_db {
my ($string, $type) = @_;
return 4;
}
sub to_db {
return 8
}
package test2;
sub from_db {
return 8
}
|
