X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FPg.pm;h=250707b90a9a08e116f8e41bfbafadc4d4dc637b;hb=548d162784058df6a57a524618337060663f9323;hp=a3788e6b80e67b70056a896c053076c1ebc55f66;hpb=dc7bcc465e3c824e46290fc802739b1e29892512;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index a3788e6..250707b 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -3,56 +3,162 @@ package DBIx::Class::Storage::DBI::Pg; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/; +use base qw/ + DBIx::Class::Storage::DBI::MultiColumnIn +/; use mro 'c3'; use DBD::Pg qw(:pg_types); +use Scope::Guard (); +use Context::Preserve (); # Ask for a DBD::Pg with array support -warn "DBD::Pg 2.9.2 or greater is strongly recommended\n" +warn __PACKAGE__.": DBD::Pg 2.9.2 or greater is strongly recommended\n" if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv() +sub can_insert_returning { + my $self = shift; + + return 1 + if $self->_server_info->{dbms_ver_normalized} >= 8.002; + + return 0; +} + sub with_deferred_fk_checks { my ($self, $sub) = @_; - $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED'); - $sub->(); + my $txn_scope_guard = $self->txn_scope_guard; + + $self->_do_query('SET CONSTRAINTS ALL DEFERRED'); + + my $sg = Scope::Guard->new(sub { + $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE'); + }); + + return Context::Preserve::preserve_context(sub { $sub->() }, + after => sub { $txn_scope_guard->commit }); } +# only used when INSERT ... RETURNING is disabled sub last_insert_id { my ($self,$source,@cols) = @_; - return map $self->dbh_do('_dbh_last_insert_id', $source, $_ ), @cols; + my @values; + + for my $col (@cols) { + my $seq = ( $source->column_info($col)->{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) ) + or $self->throw_exception( sprintf( + 'could not determine sequence for column %s.%s, please consider adding a schema-qualified sequence to its column info', + $source->name, + $col, + )); + + push @values, $self->_dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq}); + } + + return @values; } -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col ) = @_; +sub _sequence_fetch { + my ($self, $function, $sequence) = @_; - # if a sequence is defined, explicitly specify it to DBD::Pg's last_insert_id() - if( my $seq = $source->column_info($col)->{sequence} ) { - return $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq}); + $self->throw_exception('No sequence to fetch') unless $sequence; - } - # if not, parse out the schema and table names, pass them to - # DBD::Pg, and let it figure out (and cache) the sequence name - # itself. - else { + my ($val) = $self->_get_dbh->selectrow_array( + sprintf ("select %s('%s')", $function, $sequence) + ); + + return $val; +} - my $schema; - my $table = $source->name; +sub _dbh_get_autoinc_seq { + my ($self, $dbh, $source, $col) = @_; - # deref table name if necessary - $table = $$table if ref $table eq 'SCALAR'; + my $schema; + my $table = $source->name; - # parse out schema name if present - if ( $table =~ /^(.+)\.(.+)$/ ) { - ( $schema, $table ) = ( $1, $2 ); - } + # deref table name if it needs it + $table = $$table + if ref $table eq 'SCALAR'; - return $dbh->last_insert_id( undef, $schema, $table, undef ); + # parse out schema name if present + if( $table =~ /^(.+)\.(.+)$/ ) { + ( $schema, $table ) = ( $1, $2 ); } + + # get the column default using a Postgres-specific pg_catalog query + my $seq_expr = $self->_dbh_get_column_default( $dbh, $schema, $table, $col ); + + # if no default value is set on the column, or if we can't parse the + # default value as a sequence, throw. + unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ) { + $seq_expr = '' unless defined $seq_expr; + $schema = "$schema." if defined $schema && length $schema; + $self->throw_exception( sprintf ( + 'no sequence found for %s%s.%s, check the RDBMS table definition or explicitly set the '. + "'sequence' for this column in %s", + $schema ? "$schema." : '', + $table, + $col, + $source->source_name, + )); + } + + return $1; } +# custom method for fetching column default, since column_info has a +# bug with older versions of DBD::Pg +sub _dbh_get_column_default { + my ( $self, $dbh, $schema, $table, $col ) = @_; + + # Build and execute a query into the pg_catalog to find the Pg + # expression for the default value for this column in this table. + # If the table name is schema-qualified, query using that specific + # schema name. + + # Otherwise, find the table in the standard Postgres way, using the + # search path. This is done with the pg_catalog.pg_table_is_visible + # function, which returns true if a given table is 'visible', + # meaning the first table of that name to be found in the search + # path. + + # I *think* we can be assured that this query will always find the + # correct column according to standard Postgres semantics. + # + # -- rbuels + + my $sqlmaker = $self->sql_maker; + local $sqlmaker->{bindtype} = 'normal'; + + my ($where, @bind) = $sqlmaker->where ({ + 'a.attnum' => {'>', 0}, + 'c.relname' => $table, + 'a.attname' => $col, + -not_bool => 'a.attisdropped', + (defined $schema && length $schema) + ? ( 'n.nspname' => $schema ) + : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' ) + }); + + my ($seq_expr) = $dbh->selectrow_array(<_get_dbh->selectrow_array("SELECT nextval('${seq}')"); - return $id; -} - sub _svp_begin { my ($self, $name) = @_; @@ -109,8 +209,8 @@ DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL =head1 SYNOPSIS - # In your table classes - __PACKAGE__->load_components(qw/PK::Auto Core/); + # In your result (table) classes + use base 'DBIx::Class::Core'; __PACKAGE__->set_primary_key('id'); __PACKAGE__->sequence('mysequence');