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 last_insert_id {
  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 "
  26                                  . $source->name
  27                                  . ".$col, please consider adding a "
  28                                  . "schema-qualified sequence to its column info"
  29                                );
  30
  31   $self->_dbh_last_insert_id ($self->_dbh, $seq);
  32 }
  33
  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});
  39 }
  40
  41
  42 sub _get_pg_search_path {
  43     my ($self,$dbh) = @_;
  44     # cache the search path as ['schema','schema',...] in the storage
  45     # obj
  46     $self->{_pg_search_path} ||= do {
  47         my @search_path;
  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'")
  52             }
  53             push @search_path, $1;
  54         }
  55         \@search_path
  56     };
  57 }
  58
  59 sub _dbh_get_autoinc_seq {
  60   my ($self, $dbh, $schema, $table, $col) = @_;
  61
  62   # get the list of postgres schemas to search.  if we have a schema
  63   # specified, use that.  otherwise, use the search path
  64   my @search_path;
  65   if( defined $schema and length $schema ) {
  66       @search_path = ( $schema );
  67   } else {
  68       @search_path = @{ $self->_get_pg_search_path($dbh) };
  69   }
  70
  71   # find the sequence(s) of the column in question (should have nextval declared on it)
  72   my @sequence_names;
  73   foreach my $search_schema (@search_path) {
  74     my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
  75     if($info && defined $info->{COLUMN_DEF}
  76              && $info->{COLUMN_DEF} =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
  77     ) {
  78         push @sequence_names, $1;
  79     }
  80   }
  81
  82   if (@sequence_names != 1) {
  83     $self->throw_exception (sprintf
  84       q|Unable to reliably determine autoinc sequence name for '%s'.'%s' (possible candidates: %s)|,
  85       $table,
  86       $col,
  87       join (', ', (@sequence_names ? @sequence_names : 'none found') ),
  88     );
  89   }
  90
  91   my $seq = $sequence_names[0];
  92
  93   if( $seq !~ /\./ ) {
  94     my $sth = $dbh->prepare (
  95       'SELECT * FROM "information_schema"."sequences" WHERE "sequence_name" = ?'
  96     );
  97     $sth->execute ($seq);
  98
  99     my @seen_in_schemas;
 100     while (my $h = $sth->fetchrow_hashref) {
 101       push @seen_in_schemas, $h->{sequence_schema};
 102     }
 103
 104     if (not @seen_in_schemas) {
 105       $self->throw_exception (sprintf
 106         q|Automatically determined autoinc sequence name '%s' for '%s'.'%s' does not seem to exist...'|,
 107         $seq,
 108         $table,
 109         $col,
 110       );
 111     }
 112     elsif (@seen_in_schemas > 1) {
 113       $self->throw_exception (sprintf
 114         q|Unable to reliably fully-qualify automatically determined autoinc sequence name '%s' for '%s'.'%s' (same name exist in schemas: %s)|,
 115         $seq,
 116         $table,
 117         $col,
 118         join (', ', (@seen_in_schemas)),
 119       );
 120     }
 121     else {
 122       my $sql_maker = $self->sql_maker;
 123       $seq = join ('.', map { $sql_maker->_quote ($_) } ($seen_in_schemas[0], $seq) );
 124     }
 125   }
 126
 127   return $seq;
 128 }
 129
 130 sub get_autoinc_seq {
 131   my ($self,$source,$col) = @_;
 132
 133   my $schema;
 134   my $table = $source->name;
 135
 136   if (ref $table eq 'SCALAR') {
 137     $table = $$table;
 138   }
 139   elsif ($table =~ /^(.+)\.(.+)$/) {
 140     ($schema, $table) = ($1, $2);
 141   }
 142
 143   $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, $col);
 144 }
 145
 146 sub sqlt_type {
 147   return 'PostgreSQL';
 148 }
 149
 150 sub datetime_parser_type { return "DateTime::Format::Pg"; }
 151
 152 sub bind_attribute_by_data_type {
 153   my ($self,$data_type) = @_;
 154
 155   my $bind_attributes = {
 156     bytea => { pg_type => DBD::Pg::PG_BYTEA },
 157     blob  => { pg_type => DBD::Pg::PG_BYTEA },
 158   };
 159
 160   if( defined $bind_attributes->{$data_type} ) {
 161     return $bind_attributes->{$data_type};
 162   }
 163   else {
 164     return;
 165   }
 166 }
 167
 168 sub _sequence_fetch {
 169   my ( $self, $type, $seq ) = @_;
 170   my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
 171   return $id;
 172 }
 173
 174 sub _svp_begin {
 175     my ($self, $name) = @_;
 176
 177     $self->_get_dbh->pg_savepoint($name);
 178 }
 179
 180 sub _svp_release {
 181     my ($self, $name) = @_;
 182
 183     $self->_get_dbh->pg_release($name);
 184 }
 185
 186 sub _svp_rollback {
 187     my ($self, $name) = @_;
 188
 189     $self->_get_dbh->pg_rollback_to($name);
 190 }
 191
 192 1;
 193
 194 =head1 NAME
 195
 196 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
 197
 198 =head1 SYNOPSIS
 199
 200   # In your table classes
 201   __PACKAGE__->load_components(qw/PK::Auto Core/);
 202   __PACKAGE__->set_primary_key('id');
 203   __PACKAGE__->sequence('mysequence');
 204
 205 =head1 DESCRIPTION
 206
 207 This class implements autoincrements for PostgreSQL.
 208
 209 =head1 POSTGRESQL SCHEMA SUPPORT
 210
 211 This supports multiple PostgreSQL schemas, with one caveat: for
 212 performance reasons, the schema search path is queried the first time it is
 213 needed and CACHED for subsequent uses.
 214
 215 For this reason, you should do any necessary manipulation of the
 216 PostgreSQL search path BEFORE instantiating your schema object, or as
 217 part of the on_connect_do option to connect(), for example:
 218
 219    my $schema = My::Schema->connect
 220                   ( $dsn,$user,$pass,
 221                     { on_connect_do =>
 222                         [ 'SET search_path TO myschema, foo, public' ],
 223                     },
 224                   );
 225
 226 =head1 AUTHORS
 227
 228 See L<DBIx::Class/CONTRIBUTORS>
 229
 230 =head1 LICENSE
 231
 232 You may distribute this code under the same terms as Perl itself.
 233
 234 =cut