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