Commit | Line | Data |
843f8ecd |
1 | package DBIx::Class::Storage::DBI::Pg; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
be64931c |
6 | use base qw/DBIx::Class::Storage::DBI/; |
843f8ecd |
7 | |
4d4dc518 |
8 | use Scope::Guard (); |
6298a324 |
9 | use Context::Preserve 'preserve_context'; |
ee53ca0f |
10 | use DBIx::Class::Carp; |
74919a00 |
11 | use DBIx::Class::_Util 'modver_gt_or_eq'; |
6298a324 |
12 | use namespace::clean; |
843f8ecd |
13 | |
6a247f33 |
14 | __PACKAGE__->sql_limit_dialect ('LimitOffset'); |
2b8cc2f2 |
15 | __PACKAGE__->sql_quote_char ('"'); |
6f7a118e |
16 | __PACKAGE__->datetime_parser_type ('DateTime::Format::Pg'); |
be64931c |
17 | __PACKAGE__->_use_multicolumn_in (1); |
6a247f33 |
18 | |
bbdda281 |
19 | sub _determine_supports_insert_returning { |
20 | return shift->_server_info->{normalized_dbms_version} >= 8.002 |
21 | ? 1 |
22 | : 0 |
23 | ; |
38d5ea9f |
24 | } |
25 | |
e96a93df |
26 | sub with_deferred_fk_checks { |
27 | my ($self, $sub) = @_; |
28 | |
4d4dc518 |
29 | my $txn_scope_guard = $self->txn_scope_guard; |
30 | |
31 | $self->_do_query('SET CONSTRAINTS ALL DEFERRED'); |
38d5ea9f |
32 | |
ab7c6418 |
33 | my $sg = Scope::Guard->new(sub { |
34 | $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE'); |
35 | }); |
36 | |
37 | return preserve_context { $sub->() } after => sub { $txn_scope_guard->commit }; |
e96a93df |
38 | } |
39 | |
bab40dee |
40 | # only used when INSERT ... RETURNING is disabled |
38d5ea9f |
41 | sub last_insert_id { |
42 | my ($self,$source,@cols) = @_; |
43 | |
44 | my @values; |
45 | |
52416317 |
46 | my $col_info = $source->columns_info(\@cols); |
47 | |
38d5ea9f |
48 | for my $col (@cols) { |
52416317 |
49 | my $seq = ( $col_info->{$col}{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) ) |
38d5ea9f |
50 | or $self->throw_exception( sprintf( |
e705f529 |
51 | "Could not determine sequence for column '%s.%s', please consider adding a schema-qualified sequence to its column info", |
38d5ea9f |
52 | $source->name, |
53 | $col, |
54 | )); |
55 | |
56 | push @values, $self->_dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq}); |
57 | } |
58 | |
59 | return @values; |
60 | } |
61 | |
4d4dc518 |
62 | sub _sequence_fetch { |
63 | my ($self, $function, $sequence) = @_; |
64 | |
65 | $self->throw_exception('No sequence to fetch') unless $sequence; |
38d5ea9f |
66 | |
4d4dc518 |
67 | my ($val) = $self->_get_dbh->selectrow_array( |
07cda1c5 |
68 | sprintf ("select %s('%s')", $function, (ref $sequence eq 'SCALAR') ? $$sequence : $sequence) |
4d4dc518 |
69 | ); |
70 | |
71 | return $val; |
38d5ea9f |
72 | } |
9a0b7b26 |
73 | |
2d424996 |
74 | sub _dbh_get_autoinc_seq { |
75 | my ($self, $dbh, $source, $col) = @_; |
0063119f |
76 | |
2d424996 |
77 | my $schema; |
78 | my $table = $source->name; |
0063119f |
79 | |
2d424996 |
80 | # deref table name if it needs it |
81 | $table = $$table |
82 | if ref $table eq 'SCALAR'; |
0063119f |
83 | |
2d424996 |
84 | # parse out schema name if present |
85 | if( $table =~ /^(.+)\.(.+)$/ ) { |
86 | ( $schema, $table ) = ( $1, $2 ); |
87 | } |
0680ac39 |
88 | |
2d424996 |
89 | # get the column default using a Postgres-specific pg_catalog query |
90 | my $seq_expr = $self->_dbh_get_column_default( $dbh, $schema, $table, $col ); |
91 | |
92 | # if no default value is set on the column, or if we can't parse the |
93 | # default value as a sequence, throw. |
5861223d |
94 | unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ) { |
2d424996 |
95 | $seq_expr = '' unless defined $seq_expr; |
96 | $schema = "$schema." if defined $schema && length $schema; |
d3fdc7b8 |
97 | $self->throw_exception( sprintf ( |
e705f529 |
98 | "No sequence found for '%s%s.%s', check the RDBMS table definition or explicitly set the ". |
d3fdc7b8 |
99 | "'sequence' for this column in %s", |
100 | $schema ? "$schema." : '', |
101 | $table, |
102 | $col, |
103 | $source->source_name, |
104 | )); |
777f7527 |
105 | } |
2d424996 |
106 | |
d77ee505 |
107 | return $1; # exception thrown unless match is made above |
777f7527 |
108 | } |
109 | |
2d424996 |
110 | # custom method for fetching column default, since column_info has a |
111 | # bug with older versions of DBD::Pg |
112 | sub _dbh_get_column_default { |
113 | my ( $self, $dbh, $schema, $table, $col ) = @_; |
114 | |
115 | # Build and execute a query into the pg_catalog to find the Pg |
116 | # expression for the default value for this column in this table. |
117 | # If the table name is schema-qualified, query using that specific |
118 | # schema name. |
119 | |
120 | # Otherwise, find the table in the standard Postgres way, using the |
121 | # search path. This is done with the pg_catalog.pg_table_is_visible |
122 | # function, which returns true if a given table is 'visible', |
123 | # meaning the first table of that name to be found in the search |
124 | # path. |
125 | |
126 | # I *think* we can be assured that this query will always find the |
127 | # correct column according to standard Postgres semantics. |
128 | # |
129 | # -- rbuels |
130 | |
131 | my $sqlmaker = $self->sql_maker; |
132 | local $sqlmaker->{bindtype} = 'normal'; |
133 | |
134 | my ($where, @bind) = $sqlmaker->where ({ |
135 | 'a.attnum' => {'>', 0}, |
136 | 'c.relname' => $table, |
137 | 'a.attname' => $col, |
138 | -not_bool => 'a.attisdropped', |
139 | (defined $schema && length $schema) |
140 | ? ( 'n.nspname' => $schema ) |
141 | : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' ) |
142 | }); |
143 | |
144 | my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef,@bind); |
145 | |
146 | SELECT |
147 | (SELECT pg_catalog.pg_get_expr(d.adbin, d.adrelid) |
148 | FROM pg_catalog.pg_attrdef d |
149 | WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef) |
150 | FROM pg_catalog.pg_class c |
151 | LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace |
152 | JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid |
153 | $where |
154 | |
155 | EOS |
156 | |
157 | return $seq_expr; |
158 | } |
159 | |
22030f6f |
160 | sub _dbh_execute_for_fetch { |
161 | #my ($self, $source, $sth, $tuple_status, @extra) = @_; |
162 | |
163 | # This is used for bulk insert, so make sure we use a server-side |
164 | # prepared statement from the start, unless it's disabled |
165 | local $_[2]->{pg_switch_prepared} = 1 if |
166 | modver_gt_or_eq( 'DBD::Pg', '3.0.0' ) |
167 | and |
168 | $_[2]->FETCH('pg_switch_prepared') > 0 |
169 | ; |
170 | |
171 | shift->next::method(@_); |
172 | } |
2d424996 |
173 | |
4f533e8c |
174 | sub sqlt_type { |
175 | return 'PostgreSQL'; |
176 | } |
177 | |
7fe322c8 |
178 | # Pg is not able to MAX(boolean_column), sigh... |
179 | # |
180 | # Generally it would make more sense to have this in the SQLMaker hierarchy, |
181 | # so that eventually { -max => ... } DTRT, but plans going forward are |
182 | # murky at best |
183 | # --ribasushi |
184 | # |
185 | sub _minmax_operator_for_datatype { |
186 | #my ($self, $datatype, $want_max) = @_; |
187 | |
188 | return ($_[2] ? 'BOOL_OR' : 'BOOL_AND') |
189 | if ($_[1] || '') =~ /\Abool(?:ean)?\z/i; |
190 | |
191 | shift->next::method(@_); |
192 | } |
193 | |
a71859b4 |
194 | sub bind_attribute_by_data_type { |
195 | my ($self,$data_type) = @_; |
196 | |
8892d8e5 |
197 | if ($self->_is_binary_lob_type($data_type)) { |
198 | # this is a hot-ish codepath, use an escape flag to minimize |
199 | # amount of function/method calls |
8892d8e5 |
200 | # the flag is stored in the DBD namespace, so that Class::Unload |
201 | # will work (unlikely, but still) |
74919a00 |
202 | unless ( |
203 | modver_gt_or_eq( 'DBD::Pg', '2.17.2' ) |
204 | or |
205 | $DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__ |
206 | ) { |
207 | if ( $self->_server_info->{normalized_dbms_version} >= 9.0 ) { |
208 | $self->throw_exception( |
209 | 'BYTEA columns are known to not work on Pg >= 9.0 with DBD::Pg < 2.17.2' |
8892d8e5 |
210 | ); |
211 | } |
74919a00 |
212 | elsif ( |
18a2903b |
213 | require DBIx::Class::Optional::Dependencies |
214 | and |
74919a00 |
215 | my $missing = DBIx::Class::Optional::Dependencies->req_missing_for([qw( rdbms_pg binary_data )]) |
216 | ) { |
217 | # FIXME - perhaps this needs to be an exception too...? |
218 | # too old to test sensibly... |
219 | carp ( |
220 | __PACKAGE__ . ": BYTEA column support strongly recommends $missing" |
221 | ) |
222 | } |
8892d8e5 |
223 | |
224 | $DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__ = 1; |
9aec3ec6 |
225 | } |
ee53ca0f |
226 | |
8892d8e5 |
227 | return { pg_type => DBD::Pg::PG_BYTEA() }; |
228 | } |
229 | else { |
230 | return undef; |
a71859b4 |
231 | } |
232 | } |
233 | |
90d7422f |
234 | sub _exec_svp_begin { |
eeb8cfeb |
235 | my ($self, $name) = @_; |
adb3554a |
236 | |
90d7422f |
237 | $self->_dbh->pg_savepoint($name); |
adb3554a |
238 | } |
239 | |
90d7422f |
240 | sub _exec_svp_release { |
eeb8cfeb |
241 | my ($self, $name) = @_; |
adb3554a |
242 | |
90d7422f |
243 | $self->_dbh->pg_release($name); |
adb3554a |
244 | } |
245 | |
90d7422f |
246 | sub _exec_svp_rollback { |
eeb8cfeb |
247 | my ($self, $name) = @_; |
adb3554a |
248 | |
90d7422f |
249 | $self->_dbh->pg_rollback_to($name); |
adb3554a |
250 | } |
251 | |
c6375b4d |
252 | sub deployment_statements { |
253 | my $self = shift;; |
254 | my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_; |
255 | |
256 | $sqltargs ||= {}; |
257 | |
96736321 |
258 | if ( |
259 | ! exists $sqltargs->{producer_args}{postgres_version} |
260 | and |
261 | my $dver = $self->_server_info->{normalized_dbms_version} |
262 | ) { |
263 | $sqltargs->{producer_args}{postgres_version} = $dver; |
c6375b4d |
264 | } |
265 | |
266 | $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest); |
267 | } |
268 | |
843f8ecd |
269 | 1; |
270 | |
fd159e2a |
271 | __END__ |
272 | |
75d07914 |
273 | =head1 NAME |
843f8ecd |
274 | |
275 | DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL |
276 | |
277 | =head1 SYNOPSIS |
278 | |
d88ecca6 |
279 | # In your result (table) classes |
280 | use base 'DBIx::Class::Core'; |
843f8ecd |
281 | __PACKAGE__->set_primary_key('id'); |
843f8ecd |
282 | |
283 | =head1 DESCRIPTION |
284 | |
285 | This class implements autoincrements for PostgreSQL. |
286 | |
7c0176a1 |
287 | =head1 POSTGRESQL SCHEMA SUPPORT |
288 | |
4f609014 |
289 | This driver supports multiple PostgreSQL schemas, with one caveat: for |
6ff1d58c |
290 | performance reasons, data about the search path, sequence names, and |
291 | so forth is queried as needed and CACHED for subsequent uses. |
7c0176a1 |
292 | |
4f609014 |
293 | For this reason, once your schema is instantiated, you should not |
294 | change the PostgreSQL schema search path for that schema's database |
295 | connection. If you do, Bad Things may happen. |
296 | |
297 | You should do any necessary manipulation of the search path BEFORE |
298 | instantiating your schema object, or as part of the on_connect_do |
299 | option to connect(), for example: |
7c0176a1 |
300 | |
301 | my $schema = My::Schema->connect |
302 | ( $dsn,$user,$pass, |
303 | { on_connect_do => |
304 | [ 'SET search_path TO myschema, foo, public' ], |
305 | }, |
306 | ); |
307 | |
a2bd3796 |
308 | =head1 FURTHER QUESTIONS? |
7c0176a1 |
309 | |
a2bd3796 |
310 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
843f8ecd |
311 | |
a2bd3796 |
312 | =head1 COPYRIGHT AND LICENSE |
843f8ecd |
313 | |
a2bd3796 |
314 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
315 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
316 | redistribute it and/or modify it under the same terms as the |
317 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |