X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FPg.pm;h=1a2bd8aefc6b1b95cc086ef8e70c37391ce13268;hb=4f6090145bbcfb800f0b81b01fe8da7ce4d37ac5;hp=e211c05d5711c32071b15f3be3c2e5e58ace8e9e;hpb=2feba39161e40618be92a43acbaca5db3134b30a;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index e211c05..1a2bd8a 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -3,38 +3,107 @@ 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->_dbh->last_insert_id(undef,undef,undef,undef, {sequence => $seq}); + 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); +} + +# 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}); +} + + +# get the postgres search path, and cache it +sub _get_pg_search_path { + my ($self,$dbh) = @_; + # cache the search path as ['schema','schema',...] in the storage + # obj + $self->{_pg_search_path} ||= do { + my @search_path; + my ($sp_string) = $dbh->selectrow_array('SHOW search_path'); + while( $sp_string =~ s/("[^"]+"|[^,]+),?// ) { + unless( defined $1 and length $1 ) { + $self->throw_exception("search path sanity check failed: '$1'") + } + push @search_path, $1; + } + \@search_path + }; +} + +sub _dbh_get_autoinc_seq { + my ($self, $dbh, $schema, $table, $col) = @_; + + + my @where = ( 'c.relname = ?', 'a.attname = ?' ); + my @bind = ($table, $col); + if( defined $schema && length $schema ) { + push @where, 'n.nspname = ?'; + push @bind, $schema; + } else { + push @where, 'pg_catalog.pg_table_is_visible(c.oid)'; + } + my $where = join ' AND ', @where; + + my ($seq_expr) = $dbh->selectrow_array(< 0 AND NOT a.attisdropped +EOS + + $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i + or $self->throw_exception("could not parse sequence expression '$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 - } + + 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 { @@ -43,8 +112,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 @@ -60,9 +171,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