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