X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FPg.pm;h=d1319e944dd6e67e429fbf0ac6be6c7e5cdc02c9;hb=07cda1c5a7df6656772dfd65c488c19c15126168;hp=92f1a78cafd0eff393adecd7606770a294ae5a62;hpb=993fd91cb2f1d2e2c5d55fc434fec0ca3a20713e;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index 92f1a78..d1319e9 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -3,48 +3,76 @@ 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 'preserve_context'; +use namespace::clean; + +__PACKAGE__->sql_limit_dialect ('LimitOffset'); # 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 _determine_supports_insert_returning { + return shift->_server_info->{normalized_dbms_version} >= 8.002 + ? 1 + : 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 preserve_context { $sub->() } after => sub { $txn_scope_guard->commit }; } +# only used when INSERT ... RETURNING is disabled sub last_insert_id { my ($self,$source,@cols) = @_; my @values; + my $col_info = $source->columns_info(\@cols); + for my $col (@cols) { - my $seq = ( $source->column_info($col)->{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) ) - or $self->throw_exception( "could not determine sequence for " - . $source->name - . ".$col, please consider adding a " - . "schema-qualified sequence to its column info" - ); - - push @values, $self->_dbh_last_insert_id ($self->_dbh, $seq); + my $seq = ( $col_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; } -# there seems to be absolutely no reason to have this as a separate method, -# but leaving intact in case someone is already overriding it -sub _dbh_last_insert_id { - my ($self, $dbh, $seq) = @_; - $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq}); -} +sub _sequence_fetch { + my ($self, $function, $sequence) = @_; + + $self->throw_exception('No sequence to fetch') unless $sequence; + my ($val) = $self->_get_dbh->selectrow_array( + sprintf ("select %s('%s')", $function, (ref $sequence eq 'SCALAR') ? $$sequence : $sequence) + ); + + return $val; +} sub _dbh_get_autoinc_seq { my ($self, $dbh, $source, $col) = @_; @@ -61,26 +89,22 @@ sub _dbh_get_autoinc_seq { ( $schema, $table ) = ( $1, $2 ); } -### XXX This is unsafe in DBD::Pg 2.15.1, it can disconnect for some reason -### - # use DBD::Pg to fetch the column info if it is recent enough to - # work. otherwise, use custom SQL -# my $seq_expr = $DBD::Pg::VERSION >= 2.015001 -# ? eval{ $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref->{COLUMN_DEF} } -# : $self->_dbh_get_column_default( $dbh, $schema, $table, $col ); - + # 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 ){ + 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( "no sequence found for $schema$table.$col, check table definition, " - . "or explicitly set the 'sequence' for this column in the " - . $source->source_name - . " class" - ); + $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; @@ -159,12 +183,6 @@ sub bind_attribute_by_data_type { } } -sub _sequence_fetch { - my ( $self, $type, $seq ) = @_; - my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')"); - return $id; -} - sub _svp_begin { my ($self, $name) = @_; @@ -183,6 +201,23 @@ sub _svp_rollback { $self->_get_dbh->pg_rollback_to($name); } +sub deployment_statements { + my $self = shift;; + my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_; + + $sqltargs ||= {}; + + if ( + ! exists $sqltargs->{producer_args}{postgres_version} + and + my $dver = $self->_server_info->{normalized_dbms_version} + ) { + $sqltargs->{producer_args}{postgres_version} = $dver; + } + + $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest); +} + 1; __END__ @@ -193,10 +228,9 @@ 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'); =head1 DESCRIPTION