fix for pg non-schema-qualified thing, with a nice vague commit message. performance...
[dbsrgits/DBIx-Class-Historic.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
18 $self->dbh->do('SET CONSTRAINTS ALL DEFERRED');
19 $sub->();
20}
21
d4f16b21 22sub _dbh_last_insert_id {
23 my ($self, $dbh, $seq) = @_;
24 $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
0680ac39 25}
26
843f8ecd 27sub last_insert_id {
ca48cd7d 28 my ($self,$source,$col) = @_;
29 my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
d12926f6 30 $self->throw_exception("could not fetch primary key for " . $source->name . ", could not "
31 . "get autoinc sequence for $col (check that table and column specifications are correct "
32 . "and in the correct case)") unless defined $seq;
373940e1 33 $self->dbh_do('_dbh_last_insert_id', $seq);
0680ac39 34}
35
d4f16b21 36sub _dbh_get_autoinc_seq {
37 my ($self, $dbh, $schema, $table, @pri) = @_;
0680ac39 38
7dfe289b 39 # get the list of postgres schemas to search. if we have a schema
40 # specified, use that. otherwise, use the search path
41 my @search_path;
42 if( defined $schema and length $schema ) {
43 @search_path = ( $schema );
44 } else {
45 my ($search_path) = $dbh->selectrow_array('SHOW search_path');
46 while( $search_path =~ s/([^,]+),?// ) {
47 unless( defined $1 and length $1 ) {
48 $self->throw_exception("search path sanity check failed: '$1'")
49 }
50 push @search_path, $1;
51 }
52 }
53
54 foreach my $search_schema (@search_path) {
55 foreach my $col (@pri) {
56 my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
57 if($info) {
58 # if we get here, we have definitely found the right
59 # column.
60 if( defined $info->{COLUMN_DEF} and
61 $info->{COLUMN_DEF}
62 =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
63 ) {
64 my $seq = $1;
65 return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
66 } else {
67 # we have found the column, but cannot figure out
68 # the nextval seq
69 return;
70 }
71 }
72 }
0680ac39 73 }
74 return;
843f8ecd 75}
76
77sub get_autoinc_seq {
ca48cd7d 78 my ($self,$source,$col) = @_;
d4daee7b 79
843f8ecd 80 my @pri = $source->primary_columns;
34470972 81 my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2)
82 : (undef,$source->name);
a9f32dbc 83
373940e1 84 $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
843f8ecd 85}
86
4f533e8c 87sub sqlt_type {
88 return 'PostgreSQL';
89}
90
45fa8288 91sub datetime_parser_type { return "DateTime::Format::Pg"; }
92
a71859b4 93sub bind_attribute_by_data_type {
94 my ($self,$data_type) = @_;
95
96 my $bind_attributes = {
eda28767 97 bytea => { pg_type => DBD::Pg::PG_BYTEA },
5ba88f68 98 blob => { pg_type => DBD::Pg::PG_BYTEA },
a71859b4 99 };
d4daee7b 100
a71859b4 101 if( defined $bind_attributes->{$data_type} ) {
9fdf90df 102 return $bind_attributes->{$data_type};
a71859b4 103 }
104 else {
105 return;
106 }
107}
108
f04b2839 109sub _sequence_fetch {
110 my ( $self, $type, $seq ) = @_;
111 my ($id) = $self->dbh->selectrow_array("SELECT nextval('${seq}')");
112 return $id;
113}
114
adb3554a 115sub _svp_begin {
eeb8cfeb 116 my ($self, $name) = @_;
adb3554a 117
eeb8cfeb 118 $self->dbh->pg_savepoint($name);
adb3554a 119}
120
121sub _svp_release {
eeb8cfeb 122 my ($self, $name) = @_;
adb3554a 123
d6feb60f 124 $self->dbh->pg_release($name);
adb3554a 125}
126
127sub _svp_rollback {
eeb8cfeb 128 my ($self, $name) = @_;
adb3554a 129
eeb8cfeb 130 $self->dbh->pg_rollback_to($name);
adb3554a 131}
132
843f8ecd 1331;
134
75d07914 135=head1 NAME
843f8ecd 136
137DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
138
139=head1 SYNOPSIS
140
141 # In your table classes
142 __PACKAGE__->load_components(qw/PK::Auto Core/);
143 __PACKAGE__->set_primary_key('id');
144 __PACKAGE__->sequence('mysequence');
145
146=head1 DESCRIPTION
147
148This class implements autoincrements for PostgreSQL.
149
150=head1 AUTHORS
151
152Marcus Ramberg <m.ramberg@cpan.org>
153
154=head1 LICENSE
155
156You may distribute this code under the same terms as Perl itself.
157
158=cut