X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FPg.pm;h=4428b1fff5e7a9acda987b278548c5d2d6d079e4;hb=6d766626a066b757058d023830f93cf39bb9c302;hp=e7267f11bf002c9c965336f94c2311207d6ae779;hpb=49aa7e87a848acee321dbecde1eb139400f87bb5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index e7267f1..4428b1f 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -3,49 +3,136 @@ 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 _supports_insert_returning { + my $self = shift; + + return 1 + if $self->_server_info->{normalized_dbms_version} >= 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,$col) = @_; - my $seq = ($source->column_info($col)->{sequence} ||= $self->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" - ); - - $self->_dbh_last_insert_id ($self->_dbh, $seq); -} + my ($self,$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}); + } -# 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}); + return @values; } +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, $sequence) + ); + + return $val; +} sub _dbh_get_autoinc_seq { - my ($self, $dbh, $schema, $table, $col) = @_; + my ($self, $dbh, $source, $col) = @_; + + my $schema; + my $table = $source->name; + + # deref table name if it needs it + $table = $$table + if ref $table eq 'SCALAR'; + + # 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) = $self->sql_maker->where ({ + my ($where, @bind) = $sqlmaker->where ({ 'a.attnum' => {'>', 0}, 'c.relname' => $table, 'a.attname' => $col, @@ -62,35 +149,15 @@ SELECT FROM pg_catalog.pg_attrdef d WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef) FROM pg_catalog.pg_class c - JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace + LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid $where EOS - unless (defined $seq_expr && $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ){ - $seq_expr = '' unless defined $seq_expr; - $self->throw_exception("could not parse sequence expression: '$seq_expr'"); - } - - return $1; + return $seq_expr; } -sub get_autoinc_seq { - my ($self,$source,$col) = @_; - - my $schema; - my $table = $source->name; - - if (ref $table eq 'SCALAR') { - $table = $$table; - } - elsif ($table =~ /^(.+)\.(.+)$/) { - ($schema, $table) = ($1, $2); - } - - $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, $col); -} sub sqlt_type { return 'PostgreSQL'; @@ -114,12 +181,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) = @_; @@ -148,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');