1 package DBIx::Class::Storage::DBI::Pg;
6 use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
9 use DBD::Pg qw(:pg_types);
11 # Ask for a DBD::Pg with array support
12 warn "DBD::Pg 2.9.2 or greater is strongly recommended\n"
13 if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv()
15 sub with_deferred_fk_checks {
16 my ($self, $sub) = @_;
18 $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED');
23 my ($self,$source,$col) = @_;
24 my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col))
25 or $self->throw_exception( "could not determine sequence for "
27 . ".$col, please consider adding a "
28 . "schema-qualified sequence to its column info"
31 $self->_dbh_last_insert_id ($self->_dbh, $seq);
34 # there seems to be absolutely no reason to have this as a separate method,
35 # but leaving intact in case someone is already overriding it
36 sub _dbh_last_insert_id {
37 my ($self, $dbh, $seq) = @_;
38 $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
42 sub _get_pg_search_path {
44 # cache the search path as ['schema','schema',...] in the storage
46 $self->{_pg_search_path} ||= do {
48 my ($sp_string) = $dbh->selectrow_array('SHOW search_path');
49 while( $sp_string =~ s/("[^"]+"|[^,]+),?// ) {
50 unless( defined $1 and length $1 ) {
51 $self->throw_exception("search path sanity check failed: '$1'")
53 push @search_path, $1;
59 sub _dbh_get_autoinc_seq {
60 my ($self, $dbh, $schema, $table, @pri) = @_;
62 # get the list of postgres schemas to search. if we have a schema
63 # specified, use that. otherwise, use the search path
65 if( defined $schema and length $schema ) {
66 @search_path = ( $schema );
68 @search_path = @{ $self->_get_pg_search_path($dbh) };
71 foreach my $search_schema (@search_path) {
72 foreach my $col (@pri) {
73 my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
75 # if we get here, we have definitely found the right
77 if( defined $info->{COLUMN_DEF} and
79 =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
83 # have not figured out a 100% reliable way to tell
84 # what sequence is meant if it is not
85 # schema-qualified. see TODO tests in 72pg.t
89 # this guess is going to be incorrect some of
90 # the time, which could lead to problems that
91 # could be pretty hairy to trace. thus the
93 $seq = $info->{TABLE_SCHEM} . "." . $seq;
94 warn "WARNING: guessing sequence '$seq' for key $search_schema.$table.$col\n";
98 # return our (schema-qualified) seq
101 # we have found the column, but cannot figure out
111 sub get_autoinc_seq {
112 my ($self,$source,$col) = @_;
114 my @pri = $source->primary_columns;
117 my $table = $source->name;
119 if (ref $table eq 'SCALAR') {
122 elsif ($table =~ /^(.+)\.(.+)$/) {
123 ($schema, $table) = ($1, $2);
126 $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
133 sub datetime_parser_type { return "DateTime::Format::Pg"; }
135 sub bind_attribute_by_data_type {
136 my ($self,$data_type) = @_;
138 my $bind_attributes = {
139 bytea => { pg_type => DBD::Pg::PG_BYTEA },
140 blob => { pg_type => DBD::Pg::PG_BYTEA },
143 if( defined $bind_attributes->{$data_type} ) {
144 return $bind_attributes->{$data_type};
151 sub _sequence_fetch {
152 my ( $self, $type, $seq ) = @_;
153 my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
158 my ($self, $name) = @_;
160 $self->_get_dbh->pg_savepoint($name);
164 my ($self, $name) = @_;
166 $self->_get_dbh->pg_release($name);
170 my ($self, $name) = @_;
172 $self->_get_dbh->pg_rollback_to($name);
179 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
183 # In your table classes
184 __PACKAGE__->load_components(qw/PK::Auto Core/);
185 __PACKAGE__->set_primary_key('id');
186 __PACKAGE__->sequence('mysequence');
190 This class implements autoincrements for PostgreSQL.
192 =head1 POSTGRESQL SCHEMA SUPPORT
194 This supports multiple PostgreSQL schemas, with one caveat: for
195 performance reasons, the schema search path is queried the first time it is
196 needed and CACHED for subsequent uses.
198 For this reason, you should do any necessary manipulation of the
199 PostgreSQL search path BEFORE instantiating your schema object, or as
200 part of the on_connect_do option to connect(), for example:
202 my $schema = My::Schema->connect
205 [ 'SET search_path TO myschema, foo, public' ],
211 See L<DBIx::Class/CONTRIBUTORS>
215 You may distribute this code under the same terms as Perl itself.