I was wrong about 2d12a809 - the crash is real
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Pg.pm
CommitLineData
843f8ecd 1package DBIx::Class::Storage::DBI::Pg;
2
3use strict;
4use warnings;
5
be64931c 6use base qw/DBIx::Class::Storage::DBI/;
843f8ecd 7
4d4dc518 8use Scope::Guard ();
6298a324 9use Context::Preserve 'preserve_context';
ee53ca0f 10use DBIx::Class::Carp;
9aec3ec6 11use Try::Tiny;
6298a324 12use 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 19sub _determine_supports_insert_returning {
20 return shift->_server_info->{normalized_dbms_version} >= 8.002
21 ? 1
22 : 0
23 ;
38d5ea9f 24}
25
e96a93df 26sub 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
4d4dc518 33 my $sg = Scope::Guard->new(sub {
34 $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE');
35 });
36
6298a324 37 return preserve_context { $sub->() } after => sub { $txn_scope_guard->commit };
e96a93df 38}
39
bab40dee 40# only used when INSERT ... RETURNING is disabled
38d5ea9f 41sub 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(
51 'could not determine sequence for column %s.%s, please consider adding a schema-qualified sequence to its column info',
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 62sub _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 74sub _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 (
98 'no sequence found for %s%s.%s, check the RDBMS table definition or explicitly set the '.
99 "'sequence' for this column in %s",
100 $schema ? "$schema." : '',
101 $table,
102 $col,
103 $source->source_name,
104 ));
777f7527 105 }
2d424996 106
107 return $1;
777f7527 108}
109
2d424996 110# custom method for fetching column default, since column_info has a
111# bug with older versions of DBD::Pg
112sub _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
146SELECT
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)
150FROM 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
155EOS
156
157 return $seq_expr;
158}
159
160
4f533e8c 161sub sqlt_type {
162 return 'PostgreSQL';
163}
164
a71859b4 165sub bind_attribute_by_data_type {
166 my ($self,$data_type) = @_;
167
8892d8e5 168 if ($self->_is_binary_lob_type($data_type)) {
169 # this is a hot-ish codepath, use an escape flag to minimize
170 # amount of function/method calls
171 # additionally version.pm is cock, and memleaks on multiple
172 # ->VERSION calls
173 # the flag is stored in the DBD namespace, so that Class::Unload
174 # will work (unlikely, but still)
175 unless ($DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__) {
176 if ($self->_server_info->{normalized_dbms_version} >= 9.0) {
177 try { DBD::Pg->VERSION('2.17.2'); 1 } or carp (
178 __PACKAGE__.': BYTEA columns are known to not work on Pg >= 9.0 with DBD::Pg < 2.17.2'
179 );
180 }
181 elsif (not try { DBD::Pg->VERSION('2.9.2'); 1 } ) { carp (
182 __PACKAGE__.': DBD::Pg 2.9.2 or greater is strongly recommended for BYTEA column support'
183 )}
184
185 $DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__ = 1;
9aec3ec6 186 }
ee53ca0f 187
8892d8e5 188 return { pg_type => DBD::Pg::PG_BYTEA() };
189 }
190 else {
191 return undef;
a71859b4 192 }
193}
194
90d7422f 195sub _exec_svp_begin {
eeb8cfeb 196 my ($self, $name) = @_;
adb3554a 197
90d7422f 198 $self->_dbh->pg_savepoint($name);
adb3554a 199}
200
90d7422f 201sub _exec_svp_release {
eeb8cfeb 202 my ($self, $name) = @_;
adb3554a 203
90d7422f 204 $self->_dbh->pg_release($name);
adb3554a 205}
206
90d7422f 207sub _exec_svp_rollback {
eeb8cfeb 208 my ($self, $name) = @_;
adb3554a 209
90d7422f 210 $self->_dbh->pg_rollback_to($name);
adb3554a 211}
212
c6375b4d 213sub deployment_statements {
214 my $self = shift;;
215 my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
216
217 $sqltargs ||= {};
218
96736321 219 if (
220 ! exists $sqltargs->{producer_args}{postgres_version}
221 and
222 my $dver = $self->_server_info->{normalized_dbms_version}
223 ) {
224 $sqltargs->{producer_args}{postgres_version} = $dver;
c6375b4d 225 }
226
227 $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
228}
229
843f8ecd 2301;
231
fd159e2a 232__END__
233
75d07914 234=head1 NAME
843f8ecd 235
236DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
237
238=head1 SYNOPSIS
239
d88ecca6 240 # In your result (table) classes
241 use base 'DBIx::Class::Core';
843f8ecd 242 __PACKAGE__->set_primary_key('id');
843f8ecd 243
244=head1 DESCRIPTION
245
246This class implements autoincrements for PostgreSQL.
247
7c0176a1 248=head1 POSTGRESQL SCHEMA SUPPORT
249
4f609014 250This driver supports multiple PostgreSQL schemas, with one caveat: for
6ff1d58c 251performance reasons, data about the search path, sequence names, and
252so forth is queried as needed and CACHED for subsequent uses.
7c0176a1 253
4f609014 254For this reason, once your schema is instantiated, you should not
255change the PostgreSQL schema search path for that schema's database
256connection. If you do, Bad Things may happen.
257
258You should do any necessary manipulation of the search path BEFORE
259instantiating your schema object, or as part of the on_connect_do
260option to connect(), for example:
7c0176a1 261
262 my $schema = My::Schema->connect
263 ( $dsn,$user,$pass,
264 { on_connect_do =>
265 [ 'SET search_path TO myschema, foo, public' ],
266 },
267 );
268
7ff926e6 269=head1 AUTHORS
7c0176a1 270
7ff926e6 271See L<DBIx::Class/CONTRIBUTORS>
843f8ecd 272
273=head1 LICENSE
274
275You may distribute this code under the same terms as Perl itself.
276
277=cut