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 # get the postgres search path, and cache it
43 sub _get_pg_search_path {
45 # cache the search path as ['schema','schema',...] in the storage
47 $self->{_pg_search_path} ||= do {
49 my ($sp_string) = $dbh->selectrow_array('SHOW search_path');
50 while( $sp_string =~ s/("[^"]+"|[^,]+),?// ) {
51 unless( defined $1 and length $1 ) {
52 $self->throw_exception("search path sanity check failed: '$1'")
54 push @search_path, $1;
60 sub _dbh_get_autoinc_seq {
61 my ($self, $dbh, $schema, $table, $col) = @_;
64 my @where = ( 'c.relname = ?', 'a.attname = ?' );
65 my @bind = ($table, $col);
66 if( defined $schema && length $schema ) {
67 push @where, 'n.nspname = ?';
70 push @where, 'pg_catalog.pg_table_is_visible(c.oid)';
72 my $where = join ' AND ', @where;
74 my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef,@bind);
76 (SELECT pg_catalog.pg_get_expr(d.adbin, d.adrelid)
77 FROM pg_catalog.pg_attrdef d
78 WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)
79 FROM pg_catalog.pg_class c
80 JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
81 JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid
84 AND a.attnum > 0 AND NOT a.attisdropped
87 $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
88 or $self->throw_exception("could not parse sequence expression '$seq_expr'");
94 my ($self,$source,$col) = @_;
97 my $table = $source->name;
99 if (ref $table eq 'SCALAR') {
102 elsif ($table =~ /^(.+)\.(.+)$/) {
103 ($schema, $table) = ($1, $2);
106 $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, $col);
113 sub datetime_parser_type { return "DateTime::Format::Pg"; }
115 sub bind_attribute_by_data_type {
116 my ($self,$data_type) = @_;
118 my $bind_attributes = {
119 bytea => { pg_type => DBD::Pg::PG_BYTEA },
120 blob => { pg_type => DBD::Pg::PG_BYTEA },
123 if( defined $bind_attributes->{$data_type} ) {
124 return $bind_attributes->{$data_type};
131 sub _sequence_fetch {
132 my ( $self, $type, $seq ) = @_;
133 my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
138 my ($self, $name) = @_;
140 $self->_get_dbh->pg_savepoint($name);
144 my ($self, $name) = @_;
146 $self->_get_dbh->pg_release($name);
150 my ($self, $name) = @_;
152 $self->_get_dbh->pg_rollback_to($name);
161 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
165 # In your table classes
166 __PACKAGE__->load_components(qw/PK::Auto Core/);
167 __PACKAGE__->set_primary_key('id');
168 __PACKAGE__->sequence('mysequence');
172 This class implements autoincrements for PostgreSQL.
174 =head1 POSTGRESQL SCHEMA SUPPORT
176 This supports multiple PostgreSQL schemas, with one caveat: for
177 performance reasons, data about the search path, sequence names, and
178 so forth is queried as needed and CACHED for subsequent uses.
180 For this reason, you should do any necessary manipulation of the
181 PostgreSQL search path BEFORE instantiating your schema object, or as
182 part of the on_connect_do option to connect(), for example:
184 my $schema = My::Schema->connect
187 [ 'SET search_path TO myschema, foo, public' ],
193 See L<DBIx::Class/CONTRIBUTORS>
197 You may distribute this code under the same terms as Perl itself.