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