X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FPg.pm;h=a67bc2f581bfd6503fa87e1eada20a21ffdb8f1a;hb=cf52a9ad15a73aedfc1822643d63a9aa7982c72c;hp=8080b39836dba8d8a407838397353f13bd94882a;hpb=0063119f03fe9cf9d25bd08ae31920246f686ded;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index 8080b39..a67bc2f 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -3,41 +3,76 @@ package DBIx::Class::Storage::DBI::Pg; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/; -use mro 'c3'; - -use DBD::Pg qw(:pg_types); - -# Ask for a DBD::Pg with array support -warn "DBD::Pg 2.9.2 or greater is strongly recommended\n" - if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv() +use base qw/DBIx::Class::Storage::DBI/; + +use Scope::Guard (); +use Scalar::Util 'weaken'; +use Context::Preserve 'preserve_context'; +use DBIx::Class::Carp; +use Try::Tiny; +use namespace::clean; + +__PACKAGE__->sql_limit_dialect ('LimitOffset'); +__PACKAGE__->sql_quote_char ('"'); +__PACKAGE__->datetime_parser_type ('DateTime::Format::Pg'); +__PACKAGE__->_use_multicolumn_in (1); + +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'); + + weaken($self); + return preserve_context { + my $sg = Scope::Guard->new(sub { + $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE'); + }); + $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->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" - ); - - $self->_dbh_last_insert_id ($self->_dbh, $seq); -} + my ($self,$source,@cols) = @_; + + my @values; + + my $col_info = $source->columns_info(\@cols); + + for my $col (@cols) { + 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}); + } -# 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, (ref $sequence eq 'SCALAR') ? $$sequence : $sequence) + ); + + return $val; +} sub _dbh_get_autoinc_seq { my ($self, $dbh, $source, $col) = @_; @@ -54,6 +89,48 @@ sub _dbh_get_autoinc_seq { ( $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; # exception thrown unless match is made above +} + +# 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'; @@ -80,71 +157,77 @@ $where EOS - defined $seq_expr and length $seq_expr - or $self->throw_exception( "no sequence found for $table.$col, check table definition, " - . "or explicitly set the 'sequence' for this column in the " - . $source->source_name - . " class" - ); - - unless ( $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ){ - $seq_expr = '' unless defined $seq_expr; - $schema = $schema . "." if defined $schema && length $schema; - $self->throw_exception("could not parse nextval expression for $schema$table.$col: '$seq_expr'"); - } - - return $1; + return $seq_expr; } -sub get_autoinc_seq { - my ($self,$source,$col) = @_; - -} sub sqlt_type { return 'PostgreSQL'; } -sub datetime_parser_type { return "DateTime::Format::Pg"; } - sub bind_attribute_by_data_type { my ($self,$data_type) = @_; - my $bind_attributes = { - bytea => { pg_type => DBD::Pg::PG_BYTEA }, - blob => { pg_type => DBD::Pg::PG_BYTEA }, - }; - - if( defined $bind_attributes->{$data_type} ) { - return $bind_attributes->{$data_type}; + if ($self->_is_binary_lob_type($data_type)) { + # this is a hot-ish codepath, use an escape flag to minimize + # amount of function/method calls + # additionally version.pm is cock, and memleaks on multiple + # ->VERSION calls + # the flag is stored in the DBD namespace, so that Class::Unload + # will work (unlikely, but still) + unless ($DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__) { + if ($self->_server_info->{normalized_dbms_version} >= 9.0) { + try { DBD::Pg->VERSION('2.17.2'); 1 } or carp ( + __PACKAGE__.': BYTEA columns are known to not work on Pg >= 9.0 with DBD::Pg < 2.17.2' + ); + } + elsif (not try { DBD::Pg->VERSION('2.9.2'); 1 } ) { carp ( + __PACKAGE__.': DBD::Pg 2.9.2 or greater is strongly recommended for BYTEA column support' + )} + + $DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__ = 1; + } + + return { pg_type => DBD::Pg::PG_BYTEA() }; } else { - return; + return undef; } } -sub _sequence_fetch { - my ( $self, $type, $seq ) = @_; - my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')"); - return $id; +sub _exec_svp_begin { + my ($self, $name) = @_; + + $self->_dbh->pg_savepoint($name); } -sub _svp_begin { +sub _exec_svp_release { my ($self, $name) = @_; - $self->_get_dbh->pg_savepoint($name); + $self->_dbh->pg_release($name); } -sub _svp_release { +sub _exec_svp_rollback { my ($self, $name) = @_; - $self->_get_dbh->pg_release($name); + $self->_dbh->pg_rollback_to($name); } -sub _svp_rollback { - my ($self, $name) = @_; +sub deployment_statements { + my $self = shift;; + my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_; + + $sqltargs ||= {}; - $self->_get_dbh->pg_rollback_to($name); + 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; @@ -157,10 +240,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 @@ -187,12 +269,13 @@ option to connect(), for example: }, ); -=head1 AUTHORS - -See L +=head1 FURTHER QUESTIONS? -=head1 LICENSE +Check the list of L. -You may distribute this code under the same terms as Perl itself. +=head1 COPYRIGHT AND LICENSE -=cut +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.