lib/DBIx/Class/Storage/DBI/Pg.pm

   1 package DBIx::Class::Storage::DBI::Pg;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
   7 use mro 'c3';
   8
   9 use DBD::Pg qw(:pg_types);
  10
  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()
  14
  15 sub with_deferred_fk_checks {
  16   my ($self, $sub) = @_;
  17
  18   $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED');
  19   $sub->();
  20 }
  21
  22 sub _dbh_last_insert_id {
  23   my ($self, $dbh, $seq) = @_;
  24   $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
  25 }
  26
  27 sub last_insert_id {
  28   my ($self,$source,$col) = @_;
  29   my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
  30   $self->throw_exception("could not fetch primary key for " . $source->name . ", could not "
  31     . "get autoinc sequence for $col (check that table and column specifications are correct "
  32     . "and in the correct case)") unless defined $seq;
  33   $self->dbh_do('_dbh_last_insert_id', $seq);
  34 }
  35
  36 sub _get_pg_search_path {
  37     my ($self,$dbh) = @_;
  38     # cache the search path as ['schema','schema',...] in the storage
  39     # obj
  40     $self->{_pg_search_path} ||= do {
  41         my @search_path;
  42         my ($sp_string) = $dbh->selectrow_array('SHOW search_path');
  43         while( $sp_string =~ s/("[^"]+"|[^,]+),?// ) {
  44             unless( defined $1 and length $1 ) {
  45                 $self->throw_exception("search path sanity check failed: '$1'")
  46             }
  47             push @search_path, $1;
  48         }
  49         \@search_path
  50     };
  51 }
  52
  53 sub _dbh_get_autoinc_seq {
  54   my ($self, $dbh, $schema, $table, @pri) = @_;
  55
  56   # get the list of postgres schemas to search.  if we have a schema
  57   # specified, use that.  otherwise, use the search path
  58   my @search_path;
  59   if( defined $schema and length $schema ) {
  60       @search_path = ( $schema );
  61   } else {
  62       @search_path = @{ $self->_get_pg_search_path($dbh) };
  63   }
  64
  65   foreach my $search_schema (@search_path) {
  66       foreach my $col (@pri) {
  67           my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
  68           if($info) {
  69               # if we get here, we have definitely found the right
  70               # column.
  71               if( defined $info->{COLUMN_DEF} and
  72                   $info->{COLUMN_DEF}
  73                     =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
  74                 ) {
  75                   my $seq = $1;
  76                   return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
  77               } else {
  78                   # we have found the column, but cannot figure out
  79                   # the nextval seq
  80                   return;
  81               }
  82           }
  83       }
  84   }
  85   return;
  86 }
  87
  88 sub get_autoinc_seq {
  89   my ($self,$source,$col) = @_;
  90
  91   my @pri = $source->primary_columns;
  92
  93   my $schema;
  94   my $table = $source->name;
  95
  96   if (ref $table eq 'SCALAR') {
  97     $table = $$table;
  98   }
  99   elsif ($table =~ /^(.+)\.(.+)$/) {
 100     ($schema, $table) = ($1, $2);
 101   }
 102
 103   $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
 104 }
 105
 106 sub sqlt_type {
 107   return 'PostgreSQL';
 108 }
 109
 110 sub datetime_parser_type { return "DateTime::Format::Pg"; }
 111
 112 sub bind_attribute_by_data_type {
 113   my ($self,$data_type) = @_;
 114
 115   my $bind_attributes = {
 116     bytea => { pg_type => DBD::Pg::PG_BYTEA },
 117     blob  => { pg_type => DBD::Pg::PG_BYTEA },
 118   };
 119
 120   if( defined $bind_attributes->{$data_type} ) {
 121     return $bind_attributes->{$data_type};
 122   }
 123   else {
 124     return;
 125   }
 126 }
 127
 128 sub _sequence_fetch {
 129   my ( $self, $type, $seq ) = @_;
 130   my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
 131   return $id;
 132 }
 133
 134 sub _svp_begin {
 135     my ($self, $name) = @_;
 136
 137     $self->_get_dbh->pg_savepoint($name);
 138 }
 139
 140 sub _svp_release {
 141     my ($self, $name) = @_;
 142
 143     $self->_get_dbh->pg_release($name);
 144 }
 145
 146 sub _svp_rollback {
 147     my ($self, $name) = @_;
 148
 149     $self->_get_dbh->pg_rollback_to($name);
 150 }
 151
 152 1;
 153
 154 =head1 NAME
 155
 156 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
 157
 158 =head1 SYNOPSIS
 159
 160   # In your table classes
 161   __PACKAGE__->load_components(qw/PK::Auto Core/);
 162   __PACKAGE__->set_primary_key('id');
 163   __PACKAGE__->sequence('mysequence');
 164
 165 =head1 DESCRIPTION
 166
 167 This class implements autoincrements for PostgreSQL.
 168
 169 =head1 POSTGRESQL SCHEMA SUPPORT
 170
 171 This supports multiple PostgreSQL schemas, with one caveat: for
 172 performance reasons, the schema search path is queried the first time it is
 173 needed and CACHED for subsequent uses.
 174
 175 For this reason, you should do any necessary manipulation of the
 176 PostgreSQL search path BEFORE instantiating your schema object, or as
 177 part of the on_connect_do option to connect(), for example:
 178
 179    my $schema = My::Schema->connect
 180                   ( $dsn,$user,$pass,
 181                     { on_connect_do =>
 182                         [ 'SET search_path TO myschema, foo, public' ],
 183                     },
 184                   );
 185
 186 =head1 AUTHORS
 187
 188 See L<DBIx::Class/CONTRIBUTORS>
 189
 190 =head1 LICENSE
 191
 192 You may distribute this code under the same terms as Perl itself.
 193
 194 =cut