X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FPg.pm;h=8080b39836dba8d8a407838397353f13bd94882a;hb=0063119f03fe9cf9d25bd08ae31920246f686ded;hp=5d7a0bf2adc7fa68308d690a550ea24b54e06245;hpb=d12926f69a0df62c454b1c6fec2798be5c2e909f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index 5d7a0bf..8080b39 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -3,41 +3,102 @@ package DBIx::Class::Storage::DBI::Pg; use strict; use warnings; -use DBD::Pg; +use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/; +use mro 'c3'; -use base qw/DBIx::Class::Storage::DBI/; +use DBD::Pg qw(:pg_types); -# __PACKAGE__->load_components(qw/PK::Auto/); +# 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() -# Warn about problematic versions of DBD::Pg -warn "DBD::Pg 1.49 is strongly recommended" - if ($DBD::Pg::VERSION < 1.49); +sub with_deferred_fk_checks { + my ($self, $sub) = @_; + + $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED'); + $sub->(); +} sub last_insert_id { my ($self,$source,$col) = @_; - my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); - $self->throw_exception("could not fetch primary key for " . $source->name . ", could not " - . "get autoinc sequence for $col (check that table and column specifications are correct " - . "and in the correct case)") unless defined $seq; - $self->_dbh->last_insert_id(undef,undef,undef,undef, {sequence => $seq}); + 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); +} + +# 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 _dbh_get_autoinc_seq { + 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 ); + } + + 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(<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; } sub get_autoinc_seq { my ($self,$source,$col) = @_; - - my @pri = $source->primary_columns; - my $dbh = $self->_dbh; - my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2) - : (undef,$source->name); - while (my $col = shift @pri) { - my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref; - if (defined $info->{COLUMN_DEF} and $info->{COLUMN_DEF} =~ - /^nextval\(+'([^']+)'::(?:text|regclass)\)/) - { - my $seq = $1; - return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq; # may need to strip quotes -- see if this works - } - } + } sub sqlt_type { @@ -46,8 +107,50 @@ sub sqlt_type { 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}; + } + else { + return; + } +} + +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) = @_; + + $self->_get_dbh->pg_savepoint($name); +} + +sub _svp_release { + my ($self, $name) = @_; + + $self->_get_dbh->pg_release($name); +} + +sub _svp_rollback { + my ($self, $name) = @_; + + $self->_get_dbh->pg_rollback_to($name); +} + 1; +__END__ + =head1 NAME DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL @@ -63,9 +166,30 @@ DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL This class implements autoincrements for PostgreSQL. +=head1 POSTGRESQL SCHEMA SUPPORT + +This driver supports multiple PostgreSQL schemas, with one caveat: for +performance reasons, data about the search path, sequence names, and +so forth is queried as needed and CACHED for subsequent uses. + +For this reason, once your schema is instantiated, you should not +change the PostgreSQL schema search path for that schema's database +connection. If you do, Bad Things may happen. + +You should do any necessary manipulation of the search path BEFORE +instantiating your schema object, or as part of the on_connect_do +option to connect(), for example: + + my $schema = My::Schema->connect + ( $dsn,$user,$pass, + { on_connect_do => + [ 'SET search_path TO myschema, foo, public' ], + }, + ); + =head1 AUTHORS -Marcus Ramberg +See L =head1 LICENSE