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,@cols) = @_;
  24
  25   return map $self->dbh_do('_dbh_last_insert_id', $source, $_ ), @cols;
  26 }
  27
  28 sub _dbh_last_insert_id {
  29   my ($self, $dbh, $source, $col ) = @_;
  30
  31   # if a sequence is defined, explicitly specify it to DBD::Pg's last_insert_id()
  32   if( my $seq = $source->column_info($col)->{sequence} ) {
  33       return $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
  34
  35   }
  36   # if not, parse out the schema and table names, pass them to
  37   # DBD::Pg, and let it figure out (and cache) the sequence name
  38   # itself.
  39   else {
  40
  41     my $schema;
  42     my $table = $source->name;
  43
  44     # deref table name if necessary
  45     $table = $$table if ref $table eq 'SCALAR';
  46
  47     # parse out schema name if present
  48     if ( $table =~ /^(.+)\.(.+)$/ ) {
  49         ( $schema, $table ) = ( $1, $2 );
  50     }
  51
  52     return $dbh->last_insert_id( undef, $schema, $table, undef );
  53   }
  54 }
  55
  56 sub sqlt_type {
  57   return 'PostgreSQL';
  58 }
  59
  60 sub datetime_parser_type { return "DateTime::Format::Pg"; }
  61
  62 sub bind_attribute_by_data_type {
  63   my ($self,$data_type) = @_;
  64
  65   my $bind_attributes = {
  66     bytea => { pg_type => DBD::Pg::PG_BYTEA },
  67     blob  => { pg_type => DBD::Pg::PG_BYTEA },
  68   };
  69
  70   if( defined $bind_attributes->{$data_type} ) {
  71     return $bind_attributes->{$data_type};
  72   }
  73   else {
  74     return;
  75   }
  76 }
  77
  78 sub _sequence_fetch {
  79   my ( $self, $type, $seq ) = @_;
  80   my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
  81   return $id;
  82 }
  83
  84 sub _svp_begin {
  85     my ($self, $name) = @_;
  86
  87     $self->_get_dbh->pg_savepoint($name);
  88 }
  89
  90 sub _svp_release {
  91     my ($self, $name) = @_;
  92
  93     $self->_get_dbh->pg_release($name);
  94 }
  95
  96 sub _svp_rollback {
  97     my ($self, $name) = @_;
  98
  99     $self->_get_dbh->pg_rollback_to($name);
 100 }
 101
 102 1;
 103
 104 __END__
 105
 106 =head1 NAME
 107
 108 DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
 109
 110 =head1 SYNOPSIS
 111
 112   # In your table classes
 113   __PACKAGE__->load_components(qw/PK::Auto Core/);
 114   __PACKAGE__->set_primary_key('id');
 115   __PACKAGE__->sequence('mysequence');
 116
 117 =head1 DESCRIPTION
 118
 119 This class implements autoincrements for PostgreSQL.
 120
 121 =head1 POSTGRESQL SCHEMA SUPPORT
 122
 123 This driver supports multiple PostgreSQL schemas, with one caveat: for
 124 performance reasons, data about the search path, sequence names, and
 125 so forth is queried as needed and CACHED for subsequent uses.
 126
 127 For this reason, once your schema is instantiated, you should not
 128 change the PostgreSQL schema search path for that schema's database
 129 connection. If you do, Bad Things may happen.
 130
 131 You should do any necessary manipulation of the search path BEFORE
 132 instantiating your schema object, or as part of the on_connect_do
 133 option to connect(), for example:
 134
 135    my $schema = My::Schema->connect
 136                   ( $dsn,$user,$pass,
 137                     { on_connect_do =>
 138                         [ 'SET search_path TO myschema, foo, public' ],
 139                     },
 140                   );
 141
 142 =head1 AUTHORS
 143
 144 See L<DBIx::Class/CONTRIBUTORS>
 145
 146 =head1 LICENSE
 147
 148 You may distribute this code under the same terms as Perl itself.
 149
 150 =cut