| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package DBIx::PgLink::Local; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# NOTE: this is general-purpose light-weight non-Moose class |
|
4
|
|
|
|
|
|
|
# NOTE: at compile time PL/Perl subroutines are not functional |
|
5
|
|
|
|
|
|
|
# NOTE: all non-critical messages logged with INFO severity |
|
6
|
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
104639
|
use strict; |
|
|
2
|
|
|
|
|
7
|
|
|
|
2
|
|
|
|
|
87
|
|
|
8
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
66
|
|
|
9
|
2
|
|
|
2
|
|
11
|
use Exporter; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
1570
|
|
|
10
|
2
|
|
|
2
|
|
14
|
use Carp; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
315
|
|
|
11
|
2
|
|
|
2
|
|
2061
|
use Tie::Cache::LRU; |
|
|
2
|
|
|
|
|
40271
|
|
|
|
2
|
|
|
|
|
64
|
|
|
12
|
2
|
|
|
2
|
|
507
|
use DBIx::PgLink::Logger; |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
226
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
|
17
|
|
|
|
|
|
|
our @EXPORT = qw(pg_dbh); |
|
18
|
|
|
|
|
|
|
|
|
19
|
2
|
|
|
2
|
|
15
|
use constant 'pg_dbh' => bless \(my $anon_scalar), __PACKAGE__; # singleton |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
117
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
2
|
|
|
2
|
|
11
|
use constant 'default_plan_cache_size' => 100; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
4939
|
|
|
22
|
|
|
|
|
|
|
our %cached_plans; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
our $quote_ident_only_if_necessary = 1; # little slower, but no excessive quoting ("foo","bar",etc.) |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub prepare { |
|
27
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
28
|
0
|
|
|
|
|
0
|
return DBIx::PgLink::Local::st->prepare(@_); |
|
29
|
|
|
|
|
|
|
} |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub _attr_types { |
|
33
|
|
|
|
|
|
|
# in : $attr |
|
34
|
|
|
|
|
|
|
# out : list of types |
|
35
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
36
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
37
|
0
|
0
|
|
|
|
0
|
my $t = ref $attr eq 'HASH' ? $attr->{types} : undef; |
|
38
|
0
|
|
|
|
|
0
|
my $r = ref $t; |
|
39
|
0
|
|
|
|
|
0
|
return map { uc } ( |
|
|
0
|
|
|
|
|
0
|
|
|
40
|
|
|
|
|
|
|
$r eq '' && $t ? ($t) # { types => 'INT4' } |
|
41
|
|
|
|
|
|
|
: $r eq 'SCALAR' ? ($$t) # { types => \$type } |
|
42
|
0
|
|
|
|
|
0
|
: $r eq 'ARRAY' ? @{$t} # { types => ['TEXT', 'INT4'] } |
|
43
|
|
|
|
|
|
|
: $r eq 'HASH' ? # { types => {1=>'TEXT', 2=>'INT4'} } |
|
44
|
0
|
0
|
0
|
|
|
0
|
map { $t->{$_} } sort { $a<=>$b } keys %{$t} |
|
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
: () |
|
46
|
|
|
|
|
|
|
); |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub _query_key { |
|
51
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
52
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
53
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
54
|
0
|
|
|
|
|
0
|
my @types = $self->_attr_types($attr); |
|
55
|
0
|
0
|
|
|
|
0
|
$query .= "\nparams(" . join(",", @types) . ")" if @types; |
|
56
|
0
|
|
|
|
|
0
|
return $query; |
|
57
|
|
|
|
|
|
|
} |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub prepare_cached { |
|
61
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
62
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
63
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
64
|
|
|
|
|
|
|
|
|
65
|
0
|
0
|
|
|
|
0
|
if ($attr->{no_cache}) { |
|
66
|
0
|
|
|
|
|
0
|
return DBIx::PgLink::Local::st->prepare($query, $attr); |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
0
|
unless (tied %cached_plans) { |
|
70
|
|
|
|
|
|
|
my $cache_size = |
|
71
|
0
|
|
0
|
|
|
0
|
eval { |
|
72
|
|
|
|
|
|
|
my $rv = main::spi_exec_query(q/SELECT current_setting('plperl.plan_cache_size')/); |
|
73
|
|
|
|
|
|
|
$rv->{rows}->[0]->{current_setting}; |
|
74
|
|
|
|
|
|
|
} # fails if custom_variable_classes not include 'plperl' |
|
75
|
|
|
|
|
|
|
|| default_plan_cache_size; |
|
76
|
0
|
|
|
|
|
0
|
tie %cached_plans, 'Tie::Cache::LRU', $cache_size; |
|
77
|
|
|
|
|
|
|
} |
|
78
|
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
0
|
my $key = $self->_query_key($query, $attr); |
|
80
|
|
|
|
|
|
|
|
|
81
|
0
|
0
|
|
|
|
0
|
if (exists $cached_plans{$key}) { |
|
82
|
0
|
0
|
|
|
|
0
|
trace_msg("INFO", "Reuse plan for '$key'") if trace_level >= 3; |
|
83
|
0
|
|
|
|
|
0
|
return $cached_plans{$key}; |
|
84
|
|
|
|
|
|
|
} else { |
|
85
|
0
|
|
|
|
|
0
|
return $cached_plans{$key} = DBIx::PgLink::Local::st->prepare($query, $attr); |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub do { |
|
91
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
92
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
93
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
94
|
0
|
0
|
|
|
|
0
|
$attr->{no_cursor} = 1 unless exists $attr->{no_cursor}; # don't create cursor |
|
95
|
0
|
0
|
|
|
|
0
|
$attr->{no_parse} = 1 unless @_; # skip parsing if no parameter values |
|
96
|
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
0
|
if ($query !~ /^\s*(SELECT|INSERT|UPDATE|DELETE)/) { |
|
98
|
0
|
0
|
|
|
|
0
|
$attr->{no_cache} = 1 unless exists $attr->{no_cache}; # don't cache plan for DDL |
|
99
|
|
|
|
|
|
|
} |
|
100
|
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
0
|
my $sth = $self->prepare_cached($query, $attr); |
|
102
|
0
|
|
|
|
|
0
|
return $sth->execute(@_); |
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub selectall_arrayref { |
|
107
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
108
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
109
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
110
|
0
|
0
|
0
|
|
|
0
|
carp "selectall_arrayref() can return only array of hashes, use Slice=>{} attribute" |
|
111
|
|
|
|
|
|
|
unless defined $attr->{Slice} && ref $attr->{Slice} eq 'HASH'; |
|
112
|
|
|
|
|
|
|
# @_ = parameters |
|
113
|
0
|
|
|
|
|
0
|
$attr->{no_cursor} = 1; |
|
114
|
0
|
|
|
|
|
0
|
my $sth = $self->prepare_cached($query, $attr); |
|
115
|
0
|
|
|
|
|
0
|
$sth->execute(@_); |
|
116
|
0
|
|
|
|
|
0
|
return $sth->fetchall_arrayref({}); |
|
117
|
|
|
|
|
|
|
} |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub selectrow_array { |
|
121
|
0
|
0
|
|
0
|
1
|
0
|
confess "list context of selectrow_array() does not implemented" if wantarray; |
|
122
|
0
|
|
|
|
|
0
|
my $self = shift; |
|
123
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
124
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
125
|
|
|
|
|
|
|
# @_ = parameters |
|
126
|
0
|
|
|
|
|
0
|
$attr->{no_cursor} = 1; |
|
127
|
0
|
|
|
|
|
0
|
my $sth = $self->prepare_cached($query, $attr); |
|
128
|
0
|
|
|
|
|
0
|
$sth->execute(@_); |
|
129
|
0
|
|
|
|
|
0
|
return $sth->fetchrow_array; |
|
130
|
|
|
|
|
|
|
} |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub selectrow_hashref { |
|
134
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
135
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
136
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
137
|
0
|
|
|
|
|
0
|
$attr->{no_cursor} = 1; |
|
138
|
|
|
|
|
|
|
# @_ = parameters |
|
139
|
0
|
|
|
|
|
0
|
my $sth = $self->prepare_cached($query, $attr); |
|
140
|
0
|
|
|
|
|
0
|
$sth->execute(@_); |
|
141
|
0
|
|
|
|
|
0
|
return $sth->fetchrow_hashref; |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub selectall_hashref { |
|
146
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
147
|
0
|
|
|
|
|
0
|
my $query = shift; |
|
148
|
0
|
|
|
|
|
0
|
my $key_field = shift; |
|
149
|
0
|
|
|
|
|
0
|
my $attr = shift; |
|
150
|
0
|
|
|
|
|
0
|
$attr->{Slice} = {}; |
|
151
|
0
|
|
|
|
|
0
|
my $data = $self->selectall_arrayref($query, $attr, @_); |
|
152
|
0
|
|
|
|
|
0
|
my $result; |
|
153
|
0
|
|
|
|
|
0
|
for my $row (@{$data}) { |
|
|
0
|
|
|
|
|
0
|
|
|
154
|
0
|
|
|
|
|
0
|
$result->{$row->{$key_field}} = $row; |
|
155
|
|
|
|
|
|
|
} |
|
156
|
0
|
|
|
|
|
0
|
return $result; |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub quote { |
|
161
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
162
|
0
|
|
|
|
|
0
|
my $q = shift; |
|
163
|
0
|
0
|
|
|
|
0
|
return 'NULL' unless defined $q; |
|
164
|
0
|
|
|
|
|
0
|
$q =~ s/'/''/g; |
|
165
|
0
|
|
|
|
|
0
|
$q = "'$q'"; |
|
166
|
0
|
0
|
|
|
|
0
|
if ($q =~ s/\\/\\\\/g) { |
|
167
|
|
|
|
|
|
|
# work with any 'standard_conforming_strings' value |
|
168
|
0
|
|
|
|
|
0
|
$q = 'E' . $q; #if pg_server_version() >= 80100; |
|
169
|
|
|
|
|
|
|
} |
|
170
|
0
|
|
|
|
|
0
|
return $q; |
|
171
|
|
|
|
|
|
|
}; |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my $quote_ident_sth; |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub quote_identifier { |
|
177
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
178
|
0
|
|
|
|
|
0
|
my @id = @_; |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# no catalog/attr |
|
181
|
0
|
|
|
|
|
0
|
for (@id) { # quote the elements |
|
182
|
0
|
0
|
|
|
|
0
|
next unless defined; |
|
183
|
0
|
0
|
|
|
|
0
|
if ($quote_ident_only_if_necessary) { |
|
184
|
0
|
0
|
|
|
|
0
|
$quote_ident_sth = $self->prepare_cached('SELECT quote_ident($1)', {no_cursor=>1}) |
|
185
|
|
|
|
|
|
|
unless $quote_ident_sth; |
|
186
|
0
|
|
|
|
|
0
|
$quote_ident_sth->execute($_); |
|
187
|
0
|
|
|
|
|
0
|
$_ = $quote_ident_sth->fetchrow_array; |
|
188
|
|
|
|
|
|
|
} else {# quote all |
|
189
|
0
|
|
|
|
|
0
|
s/"/""/g; # escape embedded quotes |
|
190
|
0
|
|
|
|
|
0
|
$_ = qq{"$_"}; |
|
191
|
|
|
|
|
|
|
} |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
# join the dots, ignoring any null/undef elements (ie schema) |
|
194
|
0
|
|
|
|
|
0
|
my $quoted_id = join '.', grep { defined } @id; |
|
|
0
|
|
|
|
|
0
|
|
|
195
|
0
|
|
|
|
|
0
|
return $quoted_id; |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#------------------------------ utils |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub pg_flush_plan_cache { |
|
202
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
203
|
0
|
|
0
|
|
|
0
|
my $key_regex = shift || qr//; |
|
204
|
0
|
|
|
|
|
0
|
delete @cached_plans{ grep /$key_regex/, keys %cached_plans }; |
|
205
|
|
|
|
|
|
|
} |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub pg_to_perl_array { |
|
209
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
210
|
0
|
|
|
|
|
0
|
my $pg_array = shift; # as string |
|
211
|
0
|
0
|
0
|
|
|
0
|
return () unless defined $pg_array && $pg_array ne '' && $pg_array ne '{}'; |
|
|
|
|
0
|
|
|
|
|
|
212
|
|
|
|
|
|
|
|
|
213
|
0
|
0
|
|
|
|
0
|
if ($pg_array =~ /^\{([^{"]*)\}$/) { |
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# simple, one-dimensional array |
|
216
|
0
|
0
|
|
|
|
0
|
return map { $_ eq 'NULL' ? undef : $_ } split ',', $1; |
|
|
0
|
|
|
|
|
0
|
|
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
} else { |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# quoted or multidimensional array |
|
221
|
|
|
|
|
|
|
# not fast, but reliable SQL conversion |
|
222
|
|
|
|
|
|
|
# WARNING: treats any array as TEXT[] |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# get dimensions of array |
|
225
|
0
|
|
|
|
|
0
|
my $dim = $self->selectrow_array('SELECT array_dims($1)', {types=>'_TEXT'}, $pg_array); |
|
226
|
|
|
|
|
|
|
|
|
227
|
0
|
0
|
|
|
|
0
|
if ($dim =~ /^\[\d+:\d+\]$/) { |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# single dimension, get set of scalars |
|
230
|
0
|
|
|
|
|
0
|
my $a = $self->selectall_arrayref(<<'END_OF_SQL', {Slice=>{}, types=>'_TEXT'}, $pg_array); |
|
231
|
|
|
|
|
|
|
SELECT $1[i] as i |
|
232
|
|
|
|
|
|
|
FROM pg_catalog.generate_series(1, array_upper($1, 1)) as a(i) |
|
233
|
|
|
|
|
|
|
END_OF_SQL |
|
234
|
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
0
|
return map { $_->{i} } @{$a}; |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
} else { |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# nested array, get set of array slices |
|
240
|
0
|
|
|
|
|
0
|
my $a = $self->selectall_arrayref(<<'END_OF_SQL', {Slice=>{}, types=>'_TEXT'}, $pg_array); |
|
241
|
|
|
|
|
|
|
SELECT $1[i:i] as i |
|
242
|
|
|
|
|
|
|
FROM pg_catalog.generate_series(1, array_upper($1, 1)) as a(i) |
|
243
|
|
|
|
|
|
|
END_OF_SQL |
|
244
|
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
return map { |
|
246
|
0
|
|
|
|
|
0
|
my $i = $_->{i}; |
|
247
|
0
|
|
|
|
|
0
|
$i =~ /^\{(.*)\}$/; # chop extra {} |
|
248
|
0
|
|
|
|
|
0
|
my @b = $self->pg_to_perl_array($1); |
|
249
|
0
|
|
|
|
|
0
|
\@b; |
|
250
|
0
|
|
|
|
|
0
|
} @{$a}; |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
} |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
} |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub pg_from_perl_array { |
|
258
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
259
|
|
|
|
|
|
|
return |
|
260
|
0
|
|
|
|
|
0
|
'{' |
|
261
|
|
|
|
|
|
|
. join(',', |
|
262
|
|
|
|
|
|
|
map { |
|
263
|
0
|
|
|
|
|
0
|
(ref $_ eq 'ARRAY') # nested array |
|
264
|
|
|
|
|
|
|
? $self->pg_from_perl_array(@{$_}) |
|
265
|
|
|
|
|
|
|
: defined $_ |
|
266
|
0
|
0
|
|
|
|
0
|
? do { # quote all values |
|
|
|
0
|
|
|
|
|
|
|
267
|
0
|
|
|
|
|
0
|
my $a = $_; |
|
268
|
0
|
|
|
|
|
0
|
$a =~ s/"/\\"/g; |
|
269
|
0
|
|
|
|
|
0
|
'"' . $a . '"' |
|
270
|
|
|
|
|
|
|
} |
|
271
|
|
|
|
|
|
|
: 'NULL' |
|
272
|
|
|
|
|
|
|
} @_ |
|
273
|
|
|
|
|
|
|
) |
|
274
|
|
|
|
|
|
|
. '}'; |
|
275
|
|
|
|
|
|
|
} |
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# HASH pseudotype, store hash as TEXT[] as 'key','value' pairs |
|
279
|
|
|
|
|
|
|
sub pg_to_perl_hash { |
|
280
|
0
|
|
|
0
|
1
|
0
|
my ($self, $pg_array) = @_; |
|
281
|
0
|
|
|
|
|
0
|
my %result = pg_dbh->pg_to_perl_array($pg_array); |
|
282
|
0
|
|
|
|
|
0
|
return \%result; |
|
283
|
|
|
|
|
|
|
} |
|
284
|
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub pg_from_perl_hash { |
|
286
|
0
|
|
|
0
|
1
|
0
|
my ($self, $hashref) = @_; |
|
287
|
0
|
|
|
|
|
0
|
return $self->pg_from_perl_array(%{$hashref}); |
|
|
0
|
|
|
|
|
0
|
|
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub pg_to_perl_encoding { |
|
292
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
293
|
0
|
|
|
|
|
0
|
my $enc = shift; |
|
294
|
0
|
|
|
|
|
0
|
$enc =~ s/^WIN(\d+)$/cp$1/; |
|
295
|
0
|
|
0
|
|
|
0
|
$enc = { |
|
296
|
|
|
|
|
|
|
#pg #perl |
|
297
|
|
|
|
|
|
|
SQL_ASCII => 'ascii', |
|
298
|
|
|
|
|
|
|
UNICODE => 'utf8', |
|
299
|
|
|
|
|
|
|
KOI8 => 'koi8-r', |
|
300
|
|
|
|
|
|
|
ALT => 'cp866', |
|
301
|
|
|
|
|
|
|
WIN => 'cp1251', |
|
302
|
|
|
|
|
|
|
#TODO |
|
303
|
|
|
|
|
|
|
}->{$enc} || $enc; |
|
304
|
0
|
|
|
|
|
0
|
return $enc; |
|
305
|
|
|
|
|
|
|
} |
|
306
|
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub pg_from_perl_boolean { |
|
308
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
309
|
0
|
|
|
|
|
0
|
my $b = shift; |
|
310
|
0
|
0
|
|
|
|
0
|
return defined $b ? $b ? 't' : 'f' : undef; |
|
|
|
0
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
} |
|
312
|
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub pg_to_perl_boolean { |
|
314
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
|
315
|
0
|
|
|
|
|
0
|
my $b = shift; |
|
316
|
0
|
0
|
|
|
|
0
|
return defined $b ? $b eq 't' ? '1' : '0' : undef; |
|
|
|
0
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
} |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
my $pg_server_version; # cached |
|
321
|
|
|
|
|
|
|
sub pg_server_version { |
|
322
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
323
|
0
|
0
|
|
|
|
0
|
return $pg_server_version if $pg_server_version; |
|
324
|
0
|
|
|
|
|
0
|
my $ver = pg_dbh->selectrow_array("SELECT version()"); |
|
325
|
0
|
|
|
|
|
0
|
my ($major, $minor, $release) = $ver =~ /^PostgreSQL (\d+)\.(\d+)\.(\d+)/; |
|
326
|
0
|
|
|
|
|
0
|
return $pg_server_version = $major*10000+$minor*100+$release; |
|
327
|
|
|
|
|
|
|
} |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
my $pg_current_database; # cached |
|
331
|
|
|
|
|
|
|
sub pg_current_database { |
|
332
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
333
|
0
|
|
0
|
|
|
0
|
return $pg_current_database |
|
334
|
|
|
|
|
|
|
|| ( $pg_current_database = pg_dbh->selectrow_array("SELECT current_database()")); |
|
335
|
|
|
|
|
|
|
} |
|
336
|
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# session_user, not cached because can be changed by SET SESSION AUTHORIZATION |
|
338
|
|
|
|
|
|
|
sub pg_session_user { |
|
339
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
340
|
0
|
|
|
|
|
0
|
return scalar(pg_dbh->selectrow_array("SELECT session_user")); |
|
341
|
|
|
|
|
|
|
} |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
1; |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
package DBIx::PgLink::Local::st; |
|
350
|
|
|
|
|
|
|
|
|
351
|
2
|
|
|
2
|
|
19
|
use strict; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
75
|
|
|
352
|
2
|
|
|
2
|
|
12
|
use warnings; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
80
|
|
|
353
|
2
|
|
|
2
|
|
12
|
use Carp; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
418
|
|
|
354
|
2
|
|
|
2
|
|
2776
|
use Data::Dumper; |
|
|
2
|
|
|
|
|
16875
|
|
|
|
2
|
|
|
|
|
160
|
|
|
355
|
2
|
|
|
2
|
|
19
|
use DBIx::PgLink::Logger; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
104
|
|
|
356
|
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
BEGIN { |
|
358
|
|
|
|
|
|
|
# alias pg_dbh constant |
|
359
|
2
|
|
|
2
|
|
11
|
no strict 'refs'; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
121
|
|
|
360
|
2
|
|
|
2
|
|
2453
|
*pg_dbh = \&DBIx::PgLink::Local::pg_dbh; |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub _find_placeholders { |
|
365
|
|
|
|
|
|
|
# in : $_[0] = query text |
|
366
|
|
|
|
|
|
|
# out : array of placeholder numbers, changed query |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# WARNING: false placeholders in literals and comments are detected |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# $1, $2, ... placeholders, PostgreSQL default |
|
371
|
8
|
100
|
|
8
|
|
11284
|
if ($_[0] =~ /\$\d/) { |
|
|
|
100
|
|
|
|
|
|
|
372
|
2
|
|
|
|
|
4
|
my %uniq; |
|
373
|
2
|
|
|
|
|
14
|
@uniq{ $_[0] =~ m/\$(\d+)/g } = (); |
|
374
|
2
|
|
|
|
|
17
|
return sort { $a <=> $b } keys %uniq; |
|
|
1
|
|
|
|
|
6
|
|
|
375
|
|
|
|
|
|
|
} |
|
376
|
|
|
|
|
|
|
# ? placeholders |
|
377
|
|
|
|
|
|
|
elsif ($_[0] =~ /[?]/) { |
|
378
|
5
|
|
|
|
|
12
|
my $cnt=0; |
|
379
|
|
|
|
|
|
|
# replace ? to $n in-place |
|
380
|
5
|
|
|
|
|
23
|
$_[0] =~ s/[?]/'$' . ++$cnt/eg; |
|
|
6
|
|
|
|
|
20
|
|
|
381
|
5
|
|
|
|
|
24
|
return (1..$cnt); |
|
382
|
|
|
|
|
|
|
} |
|
383
|
1
|
|
|
|
|
4
|
return (); |
|
384
|
|
|
|
|
|
|
} |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
our %TYPE_ALIAS = ( |
|
387
|
|
|
|
|
|
|
'int' => 'INT4', |
|
388
|
|
|
|
|
|
|
'integer' => 'INT4', |
|
389
|
|
|
|
|
|
|
'real' => 'FLOAT4', |
|
390
|
|
|
|
|
|
|
'float' => 'FLOAT8', |
|
391
|
|
|
|
|
|
|
'double' => 'FLOAT8', |
|
392
|
|
|
|
|
|
|
'double precision' => 'FLOAT8', |
|
393
|
|
|
|
|
|
|
'boolean' => 'BOOL', |
|
394
|
|
|
|
|
|
|
); |
|
395
|
|
|
|
|
|
|
$TYPE_ALIAS{uc $_} = $TYPE_ALIAS{$_} for keys %TYPE_ALIAS; |
|
396
|
|
|
|
|
|
|
# standard type aliases also allowed in Pg-8.3 |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
# constructor |
|
399
|
|
|
|
|
|
|
sub prepare { |
|
400
|
0
|
|
|
0
|
|
|
my ($proto, $query, $attr) = @_; |
|
401
|
0
|
|
0
|
|
|
|
$proto = ref $proto || $proto; |
|
402
|
0
|
0
|
|
|
|
|
$attr = ref $attr eq 'HASH' ? $attr : {}; |
|
403
|
|
|
|
|
|
|
|
|
404
|
0
|
|
|
|
|
|
my @types = pg_dbh->_attr_types($attr); |
|
405
|
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
|
my $data = { |
|
407
|
|
|
|
|
|
|
Attr => $attr, |
|
408
|
|
|
|
|
|
|
Statement => $query, |
|
409
|
|
|
|
|
|
|
Types => \@types, |
|
410
|
|
|
|
|
|
|
}; |
|
411
|
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
|
my @mapped_types = (); |
|
413
|
0
|
0
|
|
|
|
|
if (@types) { |
|
|
|
0
|
|
|
|
|
|
|
414
|
0
|
|
|
|
|
|
for my $t (@types) { |
|
415
|
|
|
|
|
|
|
# spi_prepare do not understand TYPE[] syntax for array |
|
416
|
0
|
|
|
|
|
|
my ($array, $base) = (0, $t); |
|
417
|
0
|
0
|
0
|
|
|
|
if ($t =~ /^_(.*)$/ || $t =~ /^(.*)\[\]$/) { |
|
418
|
0
|
|
|
|
|
|
($array, $base) = (1, $1); |
|
419
|
|
|
|
|
|
|
} |
|
420
|
0
|
0
|
|
|
|
|
$base = $TYPE_ALIAS{$base} if exists $TYPE_ALIAS{$base}; |
|
421
|
0
|
0
|
|
|
|
|
$t = $array ? '_' . $base : $base; |
|
422
|
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# special hash pseudotype |
|
424
|
0
|
0
|
|
|
|
|
push @mapped_types, $t eq 'HASH' ? '_TEXT' : $t; |
|
425
|
|
|
|
|
|
|
} |
|
426
|
|
|
|
|
|
|
} elsif (!$attr->{no_parse}) { |
|
427
|
|
|
|
|
|
|
# no types specified, defaults all parameters to TEXT |
|
428
|
|
|
|
|
|
|
# also replace '?' to '$1' in-place |
|
429
|
0
|
|
|
|
|
|
@mapped_types = map { 'TEXT' } _find_placeholders($query); |
|
|
0
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
} |
|
431
|
|
|
|
|
|
|
|
|
432
|
0
|
0
|
|
|
|
|
if (trace_level >= 3) { |
|
433
|
0
|
0
|
|
|
|
|
trace_msg("INFO", "spi_prepare: $query" |
|
434
|
|
|
|
|
|
|
. (@types ? "\nBind types: " . join(",", @mapped_types) : "") ) |
|
435
|
|
|
|
|
|
|
} |
|
436
|
|
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
eval { |
|
438
|
0
|
|
|
|
|
|
$data->{Plan} = main::spi_prepare($query, @mapped_types); |
|
439
|
|
|
|
|
|
|
}; |
|
440
|
0
|
0
|
0
|
|
|
|
confess "spi_prepare failed for $query: $@" if $@ || !$data->{Plan}; |
|
441
|
0
|
0
|
|
|
|
|
trace_msg("INFO", " plan=$data->{Plan}") if trace_level >= 3; |
|
442
|
|
|
|
|
|
|
|
|
443
|
0
|
|
|
|
|
|
$data->{Boolean} = _attr_arrayref($attr->{boolean}); |
|
444
|
0
|
|
|
|
|
|
$data->{Array} = _attr_arrayref($attr->{array}); |
|
445
|
0
|
|
|
|
|
|
$data->{Hash} = _attr_arrayref($attr->{hash}); |
|
446
|
|
|
|
|
|
|
|
|
447
|
0
|
|
|
|
|
|
return bless $data, $proto; |
|
448
|
|
|
|
|
|
|
} |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub _attr_arrayref { |
|
452
|
0
|
|
|
0
|
|
|
my $r = shift; |
|
453
|
0
|
0
|
|
|
|
|
return [] unless defined $r; |
|
454
|
0
|
0
|
|
|
|
|
if (ref $r eq 'ARRAY') { |
|
|
|
0
|
|
|
|
|
|
|
455
|
0
|
|
|
|
|
|
return $r; |
|
456
|
|
|
|
|
|
|
} elsif (ref $r eq 'HASH') { |
|
457
|
0
|
|
|
|
|
|
my @keys = keys %{$r}; |
|
|
0
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
|
return \@keys; |
|
459
|
|
|
|
|
|
|
} |
|
460
|
0
|
|
|
|
|
|
return []; |
|
461
|
|
|
|
|
|
|
} |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub DESTROY { |
|
465
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
466
|
0
|
|
|
|
|
|
$self->finish; |
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
sub finish { |
|
471
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
472
|
0
|
0
|
|
|
|
|
if (defined $self->{Cursor}) { |
|
473
|
0
|
0
|
|
|
|
|
trace_msg("INFO", "spi_close_cursor ($self->{Cursor})") |
|
474
|
|
|
|
|
|
|
if trace_level >= 3; |
|
475
|
0
|
|
|
|
|
|
main::spi_cursor_close($self->{Cursor}); |
|
476
|
|
|
|
|
|
|
} |
|
477
|
0
|
|
|
|
|
|
delete @{$self}{qw/Cursor Result Pos/}; |
|
|
0
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
} |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
sub _convert_params { |
|
482
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
483
|
0
|
0
|
|
|
|
|
return unless @{$self->{Types}}; |
|
|
0
|
|
|
|
|
|
|
|
484
|
0
|
|
|
|
|
|
my $i = 0; |
|
485
|
0
|
|
|
|
|
|
for my $param (@_) { |
|
486
|
0
|
|
|
|
|
|
my $type = $self->{Types}->[$i++]; |
|
487
|
0
|
0
|
0
|
|
|
|
if ($type eq 'BOOL') { |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
|
$param = pg_dbh->pg_from_perl_boolean($param); |
|
489
|
|
|
|
|
|
|
} elsif ($type =~ '^_' && ref $param eq 'ARRAY') { |
|
490
|
0
|
|
|
|
|
|
$param = pg_dbh->pg_from_perl_array(@{$param}); |
|
|
0
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
} elsif ($type eq 'HASH' && ref $param eq 'HASH') { |
|
492
|
0
|
|
|
|
|
|
$param = pg_dbh->pg_from_perl_hash($param); |
|
493
|
|
|
|
|
|
|
} |
|
494
|
|
|
|
|
|
|
} |
|
495
|
|
|
|
|
|
|
} |
|
496
|
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
sub _convert_row { |
|
499
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
500
|
0
|
|
|
|
|
|
my $row = shift; |
|
501
|
0
|
0
|
|
|
|
|
return unless $row; |
|
502
|
0
|
|
|
|
|
|
for my $field (@{$self->{Boolean}}) { |
|
|
0
|
|
|
|
|
|
|
|
503
|
0
|
0
|
|
|
|
|
next unless exists $row->{$field}; |
|
504
|
0
|
|
|
|
|
|
$row->{$field} = pg_dbh->pg_to_perl_boolean($row->{$field}); |
|
505
|
|
|
|
|
|
|
} |
|
506
|
0
|
|
|
|
|
|
for my $field (@{$self->{Array}}) { |
|
|
0
|
|
|
|
|
|
|
|
507
|
0
|
0
|
|
|
|
|
next unless exists $row->{$field}; |
|
508
|
0
|
|
|
|
|
|
my @arr= pg_dbh->pg_to_perl_array($row->{$field}); |
|
509
|
0
|
|
|
|
|
|
$row->{$field} = \@arr; |
|
510
|
|
|
|
|
|
|
} |
|
511
|
0
|
|
|
|
|
|
for my $field (@{$self->{Hash}}) { |
|
|
0
|
|
|
|
|
|
|
|
512
|
0
|
0
|
|
|
|
|
next unless exists $row->{$field}; |
|
513
|
0
|
|
|
|
|
|
$row->{$field} = pg_dbh->pg_to_perl_hash($row->{$field}); |
|
514
|
|
|
|
|
|
|
} |
|
515
|
|
|
|
|
|
|
} |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
sub execute { |
|
519
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
520
|
|
|
|
|
|
|
|
|
521
|
0
|
|
|
|
|
|
$self->finish; |
|
522
|
|
|
|
|
|
|
|
|
523
|
0
|
0
|
|
|
|
|
if ($self->{Attr}->{no_cursor}) { |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# does not use cursor, fetch all rows at once |
|
526
|
|
|
|
|
|
|
|
|
527
|
0
|
0
|
|
|
|
|
if (trace_level >= 4) { |
|
528
|
0
|
|
|
|
|
|
local $" = ','; |
|
529
|
2
|
|
|
2
|
|
13
|
no warnings; |
|
|
2
|
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
1799
|
|
|
530
|
0
|
|
|
|
|
|
trace_msg("INFO", "spi_execute_prepared ($self->{Plan} Bind: @_)") |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
|
|
533
|
0
|
|
|
|
|
|
my @param_values = @_; |
|
534
|
0
|
|
|
|
|
|
$self->_convert_params(@param_values); |
|
535
|
|
|
|
|
|
|
|
|
536
|
0
|
|
|
|
|
|
my $rv = eval { |
|
537
|
0
|
|
|
|
|
|
main::spi_exec_prepared($self->{Plan}, @param_values); |
|
538
|
|
|
|
|
|
|
}; |
|
539
|
0
|
0
|
|
|
|
|
if ($@) { |
|
540
|
0
|
0
|
|
|
|
|
confess "spi_exec_prepared failed: $@\nStatement: $self->{Statement} with " |
|
541
|
0
|
|
|
|
|
|
. join(",", map { defined $_ ? $_ : '<NULL>' } @param_values); |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
|
|
544
|
0
|
0
|
|
|
|
|
return unless ref $rv eq 'HASH'; |
|
545
|
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
|
$self->{Result} = $rv; |
|
547
|
0
|
0
|
|
|
|
|
trace_msg("INFO", "spi_execute_prepared results:\n" . Dumper($rv)) |
|
548
|
|
|
|
|
|
|
if trace_level >= 4; |
|
549
|
0
|
|
|
|
|
|
my $result = $rv->{processed}; |
|
550
|
0
|
0
|
0
|
|
|
|
$result = '0E0' if defined $result && $result eq '0'; |
|
551
|
|
|
|
|
|
|
|
|
552
|
0
|
|
|
|
|
|
return $result; |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
} else { |
|
555
|
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# open cursor |
|
557
|
|
|
|
|
|
|
|
|
558
|
0
|
0
|
|
|
|
|
if (trace_level >= 4) { |
|
559
|
0
|
|
|
|
|
|
local $" = ','; |
|
560
|
0
|
|
|
|
|
|
trace_msg("INFO", "spi_query_prepared ($self->{Plan}, Bind: @_)") |
|
561
|
|
|
|
|
|
|
} |
|
562
|
|
|
|
|
|
|
|
|
563
|
0
|
|
|
|
|
|
undef $self->{Cursor}; |
|
564
|
|
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
|
my @param_values = @_; |
|
566
|
0
|
|
|
|
|
|
$self->_convert_params(@param_values); |
|
567
|
|
|
|
|
|
|
|
|
568
|
0
|
|
|
|
|
|
$self->{Cursor} = eval { |
|
569
|
0
|
|
|
|
|
|
main::spi_query_prepared($self->{Plan}, @param_values) |
|
570
|
|
|
|
|
|
|
}; |
|
571
|
0
|
0
|
0
|
|
|
|
confess "spi_query_prepared failed: $@\nStatement: $self->{Statement} with " . join(",", @param_values) |
|
572
|
|
|
|
|
|
|
if $@ || !defined $self->{Cursor}; |
|
573
|
|
|
|
|
|
|
|
|
574
|
0
|
|
|
|
|
|
return -1; # cannot get row count before fetching all rows |
|
575
|
|
|
|
|
|
|
} |
|
576
|
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
} |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
sub fetchall_arrayref { |
|
581
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
582
|
0
|
|
|
|
|
|
my $attr = shift; |
|
583
|
0
|
0
|
0
|
|
|
|
carp "fetchall_arrayref() can return only array of hashes, use {} attribute" |
|
584
|
|
|
|
|
|
|
unless defined $attr && ref $attr eq 'HASH'; |
|
585
|
0
|
0
|
|
|
|
|
if (defined (my $rv = $self->{Result})) { |
|
|
|
0
|
|
|
|
|
|
|
586
|
0
|
|
|
|
|
|
$self->_convert_row($_) for @{$self->{Result}->{rows}}; |
|
|
0
|
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
|
return $rv->{rows}; |
|
588
|
|
|
|
|
|
|
} |
|
589
|
|
|
|
|
|
|
elsif (defined $self->{Cursor}) { |
|
590
|
0
|
|
|
|
|
|
my @result = (); |
|
591
|
0
|
0
|
|
|
|
|
trace_msg("INFO", "fetch all rows by spi_fetchrow($self->{Plan})") |
|
592
|
|
|
|
|
|
|
if trace_level >= 3; |
|
593
|
0
|
|
|
|
|
|
while (defined (my $row = main::spi_fetchrow($self->{Cursor}))) { |
|
594
|
0
|
|
|
|
|
|
$self->_convert_row($row); |
|
595
|
0
|
|
|
|
|
|
push @result, $row; |
|
596
|
|
|
|
|
|
|
} |
|
597
|
0
|
|
|
|
|
|
return \@result; |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
else { |
|
600
|
0
|
0
|
|
|
|
|
trace_msg("INFO", "fetch failed: no statement executing for $self->{Statement}") |
|
601
|
|
|
|
|
|
|
if trace_level >= 3; |
|
602
|
|
|
|
|
|
|
} |
|
603
|
|
|
|
|
|
|
} |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
sub fetchrow_hashref { |
|
607
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
608
|
0
|
|
|
|
|
|
my $result; |
|
609
|
0
|
0
|
|
|
|
|
if (defined (my $rv = $self->{Result})) { |
|
|
|
0
|
|
|
|
|
|
|
610
|
0
|
|
|
|
|
|
$result = $rv->{rows}->[ $self->{Pos}++ ]; |
|
611
|
|
|
|
|
|
|
} |
|
612
|
|
|
|
|
|
|
elsif (defined $self->{Cursor}) { |
|
613
|
0
|
0
|
|
|
|
|
trace_msg("INFO", " spi_fetchrow($self->{Cursor})") |
|
614
|
|
|
|
|
|
|
if trace_level >= 4; |
|
615
|
0
|
|
|
|
|
|
$result = main::spi_fetchrow($self->{Cursor}); |
|
616
|
|
|
|
|
|
|
} |
|
617
|
|
|
|
|
|
|
else { # not error |
|
618
|
0
|
0
|
|
|
|
|
trace_msg("WARNING", "fetch failed: no statement executing for $self->{Statement}") |
|
619
|
|
|
|
|
|
|
if trace_level >= 4; |
|
620
|
|
|
|
|
|
|
} |
|
621
|
0
|
0
|
|
|
|
|
trace_msg("INFO", "fetchrow_hashref result:\n" . Dumper($result)) |
|
622
|
|
|
|
|
|
|
if trace_level >= 4; |
|
623
|
0
|
|
|
|
|
|
$self->_convert_row($result); |
|
624
|
0
|
|
|
|
|
|
return $result; |
|
625
|
|
|
|
|
|
|
} |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub fetchrow_array { |
|
629
|
0
|
0
|
|
0
|
|
|
confess "list context of fetchrow_array() does not implemented" if wantarray; |
|
630
|
0
|
|
|
|
|
|
my $self = shift; |
|
631
|
0
|
|
|
|
|
|
my $row = $self->fetchrow_hashref; |
|
632
|
0
|
0
|
|
|
|
|
return defined $row ? (each %{$row})[1] : undef; |
|
|
0
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
} |
|
634
|
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
1; |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
__END__ |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=head1 NAME |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
DBIx::PgLink::Local - DBI emulation for local data access in PostgreSQL PL/Perl function |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
I<PostgreSQL script> |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
CREATE FUNCTION fn() RETURNS ... LANGUAGE plperlu AS $$ |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
... |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
use DBIx::PgLink::Local; |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
$q = pg_dbh->prepare( q<SELECT 'Hello, ' || ? as foo> ); |
|
654
|
|
|
|
|
|
|
$q->execute("world"); |
|
655
|
|
|
|
|
|
|
while (my $row = $q->fetchrow_hashref) { |
|
656
|
|
|
|
|
|
|
elog 'INFO', $row->{foo}; # prints 'Hello, world' |
|
657
|
|
|
|
|
|
|
} |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
... |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
$v = pg_dbh->selectrow_array( |
|
662
|
|
|
|
|
|
|
'SELECT $1 * $1 as bar', # query string |
|
663
|
|
|
|
|
|
|
{ types=>['INT4'] } ), # attributes |
|
664
|
|
|
|
|
|
|
3 # parameter values |
|
665
|
|
|
|
|
|
|
); |
|
666
|
|
|
|
|
|
|
elog 'INFO', $v; # prints '9' |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
... |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
$$ |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
B<WARNING: this module works only in PostgreSQL functions written in I<PL/PerlU> language |
|
675
|
|
|
|
|
|
|
in PostgreSQL server version 8.2 or higher.> |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
DBIx::PgLink::Local is a wrapper around PL/Perl Server Programming Interface (SPI) functions. |
|
678
|
|
|
|
|
|
|
Module provides only basic functions of L<DBI>. |
|
679
|
|
|
|
|
|
|
For full DBI-compatible driver look at L<DBD::PgSPI>. |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
Module manage prepared statements and cache query plans. |
|
682
|
|
|
|
|
|
|
It is not depend on other L<DBIx::PgLink> code (except L<DBIx::PgLink::Logger>) |
|
683
|
|
|
|
|
|
|
and can be used in any PL/Perl function. |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=head1 SUBROUTINES |
|
686
|
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=over |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
=item C<pg_dbh> |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
Returns singleton instance of class DBIx::PgLink::Local. Exported by default. |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=back |
|
694
|
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=head1 METHODS |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=over |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=item C<quote> |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
$sql = pg_dbh->quote($value); |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Quote a string literal for use as a literal value in an SQL statement, |
|
705
|
|
|
|
|
|
|
by escaping single quote and backslash characters and adding the single quotes. |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=item C<quote_identifier> |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
$sql = pg_dbh->quote_identifier( $name ); |
|
710
|
|
|
|
|
|
|
$sql = pg_dbh->quote_identifier( $schema, $object ); |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
Quote an identifier (table name etc.) for use in an SQL statement, |
|
713
|
|
|
|
|
|
|
by escaping double quote and adding double quotes. |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=item C<prepare> |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
$sth = pg_dbh->prepare($statement); |
|
718
|
|
|
|
|
|
|
$sth = pg_dbh->prepare($statement, \%attr); |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
Prepares a statement for later execution by the database |
|
721
|
|
|
|
|
|
|
engine and returns a reference to a statement handle. |
|
722
|
|
|
|
|
|
|
Statement handle is object containing query plan. |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
Supports $n ("dollar sign numbers") and ? (question mark) placeholder styles. |
|
725
|
|
|
|
|
|
|
$n-style is PostgreSQL default and preferred over quotation marks. |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
Wrapped C<spi_prepare()> function cannot infer parameter data type from the context, |
|
728
|
|
|
|
|
|
|
although SQL command C<PREPARE> can. |
|
729
|
|
|
|
|
|
|
If no parameter types specified, C<prepare> implicitly detect placeholders |
|
730
|
|
|
|
|
|
|
and assign 'TEXT' type to all of them. |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
C<prepare> attributes: |
|
733
|
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=over |
|
735
|
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=item C<types> |
|
737
|
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Supply explicit data type names for parameters in C<types> attribute as array-ref: |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
$sth = pg_dbh->prepare( |
|
741
|
|
|
|
|
|
|
'SELECT * FROM foo WHERE bar=$1 and baz=$2', |
|
742
|
|
|
|
|
|
|
{ types => [qw/TEXT INT4/] } |
|
743
|
|
|
|
|
|
|
); |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Type names are case insensitive. |
|
746
|
|
|
|
|
|
|
Examples: 'TEXT', 'INT4', 'INT8', 'FLOAT4', 'FLOAT8'. |
|
747
|
|
|
|
|
|
|
In addition 'int', 'integer' are aliased to 'INT4', 'double' to 'FLOAT8'. |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
B<Only "dollar sign number" placeholders can be used with explicit types.> |
|
750
|
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
See alse "Placeholders" in L<DBD::Pg>. |
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=item C<boolean> |
|
754
|
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
Array-ref containing field names in result set with boolean type. |
|
756
|
|
|
|
|
|
|
Converts PostgreSQL boolean values to Perl ('f' -> 0, 't' -> 1). |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
Also accepted hashref with field name as key. |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item C<array> |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Array-ref containing field names in result set with array type. |
|
763
|
|
|
|
|
|
|
Converts PostgreSQL array values to Perl array. |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
Also accepted hashref with field name as key. |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=item C<no_cursor> |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Boolean: do not create cursor and fetch all data at once. |
|
770
|
|
|
|
|
|
|
Automatically set for any not SELECT/INSERT/UPDATE/DELETE query. |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=item C<no_cache> |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
Boolean: do not save query plan. |
|
775
|
|
|
|
|
|
|
Automatically set for any not SELECT/INSERT/UPDATE/DELETE query. |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=item C<no_parse> |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
Boolean: make no attempt to find placeholders in query and replace '?' marks. |
|
780
|
|
|
|
|
|
|
Automatically set for C<do> method with no parameter values. |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=back |
|
783
|
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=item C<prepare_cached> |
|
785
|
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
$sth = pg_dbh->prepare_cached($statement); |
|
787
|
|
|
|
|
|
|
$sth = pg_dbh->prepare_cached($statement, \%attr); |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
Like L</prepare> except that the plan for statement will be |
|
790
|
|
|
|
|
|
|
stored in a global (session) hash. If another call is made to |
|
791
|
|
|
|
|
|
|
C<prepare_cached> with the same C<$query> value, |
|
792
|
|
|
|
|
|
|
then the corresponding cached plan will be used. |
|
793
|
|
|
|
|
|
|
B<Statement handles are not cached>, it is safe to mix |
|
794
|
|
|
|
|
|
|
different C<prepare_cached> and C<execute> with the same query string. |
|
795
|
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
Cache is managed by LRU algorithm. Default cache size is 100. |
|
797
|
|
|
|
|
|
|
Cache size can be configured via PostgreSQL run-time parameter B<plperl.plan_cache_size>. |
|
798
|
|
|
|
|
|
|
See I<Customized Options> in PostgreSQL Manual for example how to enable I<plperl> custom variable class. |
|
799
|
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=item C<do> |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
$rows = pg_dbh->do($statement) |
|
803
|
|
|
|
|
|
|
$rows = pg_dbh->do($statement, \%attr) |
|
804
|
|
|
|
|
|
|
$rows = pg_dbh->do($statement, \%attr, @bind_values) |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
Prepare and execute a single statement. |
|
807
|
|
|
|
|
|
|
Returns the number of rows affected. Plan is cached. |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=item C<selectrow_array> |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
$scalar = pg_dbh->selectall_arrayref($statement) |
|
812
|
|
|
|
|
|
|
$scalar = pg_dbh->selectall_arrayref($statement, \%attr) |
|
813
|
|
|
|
|
|
|
$scalar = pg_dbh->selectall_arrayref($statement, \%attr, @bind_values) |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
This utility method combines C<prepare_cached>, C<execute> and C<fetchrow_hashref> into a single call. |
|
816
|
|
|
|
|
|
|
In scalar context returns single value from first row of resultset. |
|
817
|
|
|
|
|
|
|
If called for a statement handle that has more than one column, it is undefined whether column will be return. |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
NOTE: in list context always dies, because of internal limitation. |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=item C<selectrow_hashref> |
|
823
|
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
$hash_ref = $dbh->selectrow_hashref($statement); |
|
825
|
|
|
|
|
|
|
$hash_ref = $dbh->selectrow_hashref($statement, \%attr); |
|
826
|
|
|
|
|
|
|
$hash_ref = $dbh->selectrow_hashref($statement, \%attr, @bind_values); |
|
827
|
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
This utility method combines C<prepare_cached>, C<execute> and C<fetchrow_hashref> into a single call. |
|
829
|
|
|
|
|
|
|
It returns the first row of data from the statement. |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item C<selectall_arrayref> |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
$ary_ref = pg_dbh->selectall_arrayref($statement) |
|
834
|
|
|
|
|
|
|
$ary_ref = pg_dbh->selectall_arrayref($statement, \%attr) |
|
835
|
|
|
|
|
|
|
$ary_ref = pg_dbh->selectall_arrayref($statement, \%attr, @bind_values) |
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
This utility method combines C<prepare_cached>, C<execute> and C<fetchall_arrayref> into a single call. |
|
838
|
|
|
|
|
|
|
It returns a reference to an array containing a reference to a hash for each row of data fetched. |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
Note that unlike DBI C<selectall_arrayref> returns arrayref of B<hashes>. |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=item C<selectall_hashref> |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
$hash_ref = pg_dbh->selectall_hashref($statement, $key_field) |
|
845
|
|
|
|
|
|
|
$hash_ref = pg_dbh->selectall_hashref($statement, $key_field, \%attr) |
|
846
|
|
|
|
|
|
|
$hash_ref = pg_dbh->selectall_hashref($statement, $key_field, \%attr, @bind_values) |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
This utility method combines C<prepare_cached>, C<execute> and C<fetchrow_hashref> into a single call. |
|
849
|
|
|
|
|
|
|
It returns a reference to a hash containing one entry, at most, for each row, as returned by fetchall_hashref(). |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=back |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=head2 PostgreSQL-only methods |
|
854
|
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=over |
|
856
|
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=item C<pg_flush_plan_cache> |
|
858
|
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
pg_dbh->pg_flush_plan_cache; |
|
860
|
|
|
|
|
|
|
pg_dbh->pg_flush_plan_cache($regex); |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
Free all or selected prepared query plans from cache. Use after changing of database schema. |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item C<pg_to_perl_array> |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
@arr = pg_dbh->pg_to_perl_array('{1,2,3}'); |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
Convert text representation of PostgreSQL array to Perl array. |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=item C<pg_from_perl_array> |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
$string = pg_dbh->pg_from_perl_array(1,2,3,undef,'hello'); |
|
873
|
|
|
|
|
|
|
# returns '{"1","2","3",NULL,"hello"}' |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
Convert Perl array to PostgreSQL array literal. |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=item C<pg_to_perl_hash> |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
$hashref = pg_dbh->pg_to_perl_hash('{foo,1,bar,2}'); |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Convert text representation of PostgreSQL array to Perl hash. |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
This method is particularly useful for PL/Perl array argument conversion, |
|
884
|
|
|
|
|
|
|
for PL/Perl stringify it. |
|
885
|
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=item C<pg_from_perl_hash> |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
$string = pg_dbh->pg_from_perl_hash({foo=>1,bar=>2}); |
|
889
|
|
|
|
|
|
|
# returns '{foo,1,bar,2}' |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
Convert Perl hash reference to PostgreSQL array literal. |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=item C<pg_to_perl_encoding> |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Convert name of PostgreSQL encoding to Perl encoding name. See L<Encode>. |
|
896
|
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=item C<pg_server_version> |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Indicates which version of local PostgreSQL that hosts PL/Perl function. |
|
900
|
|
|
|
|
|
|
Returns a number with major, minor, and revision together; version 8.2.5 would be 80205 |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=item C<pg_current_database> |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
Returns name of local database PostgreSQL that hosts PL/Perl function. |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item C<pg_session_user> |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
Returns PostgreSQL session user name. |
|
909
|
|
|
|
|
|
|
See I<System Information Functions> chapter of PostgreSQL Manual. |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=back |
|
912
|
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=head1 STATEMENT METHODS |
|
915
|
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=over |
|
917
|
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=item C<execute> |
|
919
|
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
$q->execute; |
|
921
|
|
|
|
|
|
|
$q->execute(@values); |
|
922
|
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
Execute prepared statement. |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
When statement prepared with true value of C<no_cursor> attribute, all rows are fetched at once |
|
926
|
|
|
|
|
|
|
(if it is data retrieving operation) and C<execute> returns number of proceeded rows. |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
When attribute C<no_cursor> is not set, C<execute> open cursor and fetch row-by-row. |
|
929
|
|
|
|
|
|
|
In this mode method always returns -1 because number of affected rows can not be known. |
|
930
|
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Wrapper of C<spi_exec_prepared> / C<spi_query_prepared>. |
|
932
|
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=item C<fetchrow_hashref> |
|
934
|
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
$hash_ref = $q->fetchrow_hashref; |
|
936
|
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
Fetches the next row of data and returns a reference to an hash |
|
938
|
|
|
|
|
|
|
holding the field values. |
|
939
|
|
|
|
|
|
|
If there are no more rows or if an error occurs, then C<fetchrow_hashref> |
|
940
|
|
|
|
|
|
|
returns an C<undef>. |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=item C<fetchrow_array> |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
$scalar = $q->fetchrow_array; |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Fetches the next row of data and return one field value. |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
NOTE: in list context always dies, because of internal limitation. |
|
949
|
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=item C<fetchall_arrayref> |
|
951
|
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
$row_aref = $q->fetchall_arrayref; |
|
953
|
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
The method can be used to fetch all the data to be returned |
|
955
|
|
|
|
|
|
|
from a prepared and executed statement handle. |
|
956
|
|
|
|
|
|
|
It returns a reference to an array that contains one reference per row. |
|
957
|
|
|
|
|
|
|
Note that unlike DBI C<fetchall_arrayref> returns arrayref of B<hashes>. |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=item C<finish> |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
$q->finish; |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
Indicate that no more data will be fetched from this statement handle |
|
964
|
|
|
|
|
|
|
before it is either executed again or destroyed. |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Wrapper of C<spi_cursor_close>. |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=back |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=head1 CAVEATS |
|
972
|
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=over |
|
974
|
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
=item * |
|
976
|
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
SQL parsing for parameters in C<prepare> is dumb. |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
Use explicit types if query contains string like '$1' or '?' |
|
980
|
|
|
|
|
|
|
in literal, identifier or comment. |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=item * |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
Full set of selectI<XXX> and fetchI<XXX> methods is not implemented. |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
In PL/Perl data access layer every data row (tuple) converted to hash, |
|
987
|
|
|
|
|
|
|
and there is no easy way to restore original column order. |
|
988
|
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=item * |
|
990
|
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
C<selectall_arrayref> and C<fetchall_arrayref> always returns reference to array of hashes |
|
992
|
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=item * |
|
994
|
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
C<selectrow_array> and C<fetchrow_array> works in scalar context only. |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=item * |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
Data fetching slower than PL/PGSQL. |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
The tuple->hash conversion take extra time and memory. |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=item * |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
No automatic plan invalidation. |
|
1006
|
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
Use C<pg_flush_plan_cache> (or reconnect) after database schema changes. |
|
1008
|
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=item * |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
Array conversion suppose that C<array_nulls> variable is ON. |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=item * |
|
1014
|
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
Lot ot this module code will be obsolete when (and if) L<DBD::PgSPI> |
|
1016
|
|
|
|
|
|
|
starts support real prepared statements. |
|
1017
|
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
=back |
|
1019
|
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
L<DBI>, L<DBD::Pg>, L<Tie::Cache::LRU>, PostgreSQL Manual |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1027
|
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Alexey Sharafutdinov E<lt>alexey.s.v.br@gmail.comE<gt> |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=head1 LICENSE |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under |
|
1033
|
|
|
|
|
|
|
the same terms as Perl itself. |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=cut |