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 _dbh_get_autoinc_seq {
43 my ($self, $dbh, $schema, $table, $col) = @_;
45 my $sqlmaker = $self->sql_maker;
46 local $sqlmaker->{bindtype} = 'normal';
48 my ($where, @bind) = $self->sql_maker->where ({
49 'a.attnum' => {'>', 0},
50 'c.relname' => $table,
52 -not_bool => 'a.attisdropped',
53 (defined $schema && length $schema)
54 ? ( 'n.nspname' => $schema )
55 : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' )
58 my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef,@bind);
61 (SELECT pg_catalog.pg_get_expr(d.adbin, d.adrelid)
62 FROM pg_catalog.pg_attrdef d
63 WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)
64 FROM pg_catalog.pg_class c
65 JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
66 JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid
71 unless (defined $seq_expr && $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ){
72 $seq_expr = '' unless defined $seq_expr;
73 $self->throw_exception("could not parse sequence expression: '$seq_expr'");
80 my ($self,$source,$col) = @_;
83 my $table = $source->name;
85 if (ref $table eq 'SCALAR') {
88 elsif ($table =~ /^(.+)\.(.+)$/) {
89 ($schema, $table) = ($1, $2);
92 $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, $col);
99 sub datetime_parser_type { return "DateTime::Format::Pg"; }
101 sub bind_attribute_by_data_type {
102 my ($self,$data_type) = @_;
104 my $bind_attributes = {
105 bytea => { pg_type => DBD::Pg::PG_BYTEA },
106 blob => { pg_type => DBD::Pg::PG_BYTEA },
109 if( defined $bind_attributes->{$data_type} ) {
110 return $bind_attributes->{$data_type};
117 sub _sequence_fetch {
118 my ( $self, $type, $seq ) = @_;
119 my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
124 my ($self, $name) = @_;
126 $self->_get_dbh->pg_savepoint($name);
130 my ($self, $name) = @_;
132 $self->_get_dbh->pg_release($name);
136 my ($self, $name) = @_;
138 $self->_get_dbh->pg_rollback_to($name);
147 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
151 # In your table classes
152 __PACKAGE__->load_components(qw/PK::Auto Core/);
153 __PACKAGE__->set_primary_key('id');
154 __PACKAGE__->sequence('mysequence');
158 This class implements autoincrements for PostgreSQL.
160 =head1 POSTGRESQL SCHEMA SUPPORT
162 This driver supports multiple PostgreSQL schemas, with one caveat: for
163 performance reasons, data about the search path, sequence names, and
164 so forth is queried as needed and CACHED for subsequent uses.
166 For this reason, once your schema is instantiated, you should not
167 change the PostgreSQL schema search path for that schema's database
168 connection. If you do, Bad Things may happen.
170 You should do any necessary manipulation of the search path BEFORE
171 instantiating your schema object, or as part of the on_connect_do
172 option to connect(), for example:
174 my $schema = My::Schema->connect
177 [ 'SET search_path TO myschema, foo, public' ],
183 See L<DBIx::Class/CONTRIBUTORS>
187 You may distribute this code under the same terms as Perl itself.