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->dbh_do('_dbh_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, $source, $col) = @_;
46 my $table = $source->name;
48 # deref table name if it needs it
50 if ref $table eq 'SCALAR';
52 # parse out schema name if present
53 if( $table =~ /^(.+)\.(.+)$/ ) {
54 ( $schema, $table ) = ( $1, $2 );
57 my $sqlmaker = $self->sql_maker;
58 local $sqlmaker->{bindtype} = 'normal';
60 my ($where, @bind) = $sqlmaker->where ({
61 'a.attnum' => {'>', 0},
62 'c.relname' => $table,
64 -not_bool => 'a.attisdropped',
65 (defined $schema && length $schema)
66 ? ( 'n.nspname' => $schema )
67 : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' )
70 my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef,@bind);
73 (SELECT pg_catalog.pg_get_expr(d.adbin, d.adrelid)
74 FROM pg_catalog.pg_attrdef d
75 WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)
76 FROM pg_catalog.pg_class c
77 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
78 JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid
83 # if no default value is set on the column, or if we can't parse the
84 # default value as a sequence, throw.
85 unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ){
86 $seq_expr = '' unless defined $seq_expr;
87 $schema = "$schema." if defined $schema && length $schema;
88 $self->throw_exception( "no sequence found for $schema$table.$col, check table definition, "
89 . "or explicitly set the 'sequence' for this column in the "
90 . $source->source_name
99 my ($self,$source,$col) = @_;
107 sub datetime_parser_type { return "DateTime::Format::Pg"; }
109 sub bind_attribute_by_data_type {
110 my ($self,$data_type) = @_;
112 my $bind_attributes = {
113 bytea => { pg_type => DBD::Pg::PG_BYTEA },
114 blob => { pg_type => DBD::Pg::PG_BYTEA },
117 if( defined $bind_attributes->{$data_type} ) {
118 return $bind_attributes->{$data_type};
125 sub _sequence_fetch {
126 my ( $self, $type, $seq ) = @_;
127 my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
132 my ($self, $name) = @_;
134 $self->_get_dbh->pg_savepoint($name);
138 my ($self, $name) = @_;
140 $self->_get_dbh->pg_release($name);
144 my ($self, $name) = @_;
146 $self->_get_dbh->pg_rollback_to($name);
155 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
159 # In your table classes
160 __PACKAGE__->load_components(qw/PK::Auto Core/);
161 __PACKAGE__->set_primary_key('id');
162 __PACKAGE__->sequence('mysequence');
166 This class implements autoincrements for PostgreSQL.
168 =head1 POSTGRESQL SCHEMA SUPPORT
170 This driver supports multiple PostgreSQL schemas, with one caveat: for
171 performance reasons, data about the search path, sequence names, and
172 so forth is queried as needed and CACHED for subsequent uses.
174 For this reason, once your schema is instantiated, you should not
175 change the PostgreSQL schema search path for that schema's database
176 connection. If you do, Bad Things may happen.
178 You should do any necessary manipulation of the search path BEFORE
179 instantiating your schema object, or as part of the on_connect_do
180 option to connect(), for example:
182 my $schema = My::Schema->connect
185 [ 'SET search_path TO myschema, foo, public' ],
191 See L<DBIx::Class/CONTRIBUTORS>
195 You may distribute this code under the same terms as Perl itself.