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->dbh_do('_dbh_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 _dbh_get_autoinc_seq {
  43   my ($self, $dbh, $source, $col) = @_;
  44
  45   my $schema;
  46   my $table = $source->name;
  47
  48   # deref table name if it needs it
  49   $table = $$table
  50       if ref $table eq 'SCALAR';
  51
  52   # parse out schema name if present
  53   if( $table =~ /^(.+)\.(.+)$/ ) {
  54     ( $schema, $table ) = ( $1, $2 );
  55   }
  56
  57   my $sqlmaker = $self->sql_maker;
  58   local $sqlmaker->{bindtype} = 'normal';
  59
  60   my ($where, @bind) = $sqlmaker->where ({
  61     'a.attnum' => {'>', 0},
  62     'c.relname' => $table,
  63     'a.attname' => $col,
  64     -not_bool => 'a.attisdropped',
  65     (defined $schema && length $schema)
  66       ? ( 'n.nspname' => $schema )
  67       : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' )
  68   });
  69
  70   my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef,@bind);
  71
  72 SELECT
  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
  79 $where
  80
  81 EOS
  82
  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
  91                             . " class"
  92                           );
  93   }
  94
  95   return $1;
  96 }
  97
  98 sub get_autoinc_seq {
  99   my ($self,$source,$col) = @_;
 100
 101 }
 102
 103 sub sqlt_type {
 104   return 'PostgreSQL';
 105 }
 106
 107 sub datetime_parser_type { return "DateTime::Format::Pg"; }
 108
 109 sub bind_attribute_by_data_type {
 110   my ($self,$data_type) = @_;
 111
 112   my $bind_attributes = {
 113     bytea => { pg_type => DBD::Pg::PG_BYTEA },
 114     blob  => { pg_type => DBD::Pg::PG_BYTEA },
 115   };
 116
 117   if( defined $bind_attributes->{$data_type} ) {
 118     return $bind_attributes->{$data_type};
 119   }
 120   else {
 121     return;
 122   }
 123 }
 124
 125 sub _sequence_fetch {
 126   my ( $self, $type, $seq ) = @_;
 127   my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
 128   return $id;
 129 }
 130
 131 sub _svp_begin {
 132     my ($self, $name) = @_;
 133
 134     $self->_get_dbh->pg_savepoint($name);
 135 }
 136
 137 sub _svp_release {
 138     my ($self, $name) = @_;
 139
 140     $self->_get_dbh->pg_release($name);
 141 }
 142
 143 sub _svp_rollback {
 144     my ($self, $name) = @_;
 145
 146     $self->_get_dbh->pg_rollback_to($name);
 147 }
 148
 149 1;
 150
 151 __END__
 152
 153 =head1 NAME
 154
 155 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
 156
 157 =head1 SYNOPSIS
 158
 159   # In your table classes
 160   __PACKAGE__->load_components(qw/PK::Auto Core/);
 161   __PACKAGE__->set_primary_key('id');
 162   __PACKAGE__->sequence('mysequence');
 163
 164 =head1 DESCRIPTION
 165
 166 This class implements autoincrements for PostgreSQL.
 167
 168 =head1 POSTGRESQL SCHEMA SUPPORT
 169
 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.
 173
 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.
 177
 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:
 181
 182    my $schema = My::Schema->connect
 183                   ( $dsn,$user,$pass,
 184                     { on_connect_do =>
 185                         [ 'SET search_path TO myschema, foo, public' ],
 186                     },
 187                   );
 188
 189 =head1 AUTHORS
 190
 191 See L<DBIx::Class/CONTRIBUTORS>
 192
 193 =head1 LICENSE
 194
 195 You may distribute this code under the same terms as Perl itself.
 196
 197 =cut