Commit | Line | Data |
843f8ecd |
1 | package DBIx::Class::Storage::DBI::Pg; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
4ce3b851 |
6 | use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/; |
ac45262b |
7 | use mro 'c3'; |
843f8ecd |
8 | |
ac45262b |
9 | use DBD::Pg qw(:pg_types); |
843f8ecd |
10 | |
ac45262b |
11 | # Ask for a DBD::Pg with array support |
c70c716e |
12 | warn "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 |
15 | sub 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 |
22 | sub last_insert_id { |
ca48cd7d |
23 | my ($self,$source,$col) = @_; |
5f70776f |
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 | ); |
9a0b7b26 |
30 | |
31 | $self->_dbh_last_insert_id ($self->_dbh, $seq); |
0680ac39 |
32 | } |
33 | |
9a0b7b26 |
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 | |
1ff9c30d |
42 | sub _get_pg_search_path { |
43 | my ($self,$dbh) = @_; |
44 | # cache the search path as ['schema','schema',...] in the storage |
45 | # obj |
46 | $self->{_pg_search_path} ||= do { |
47 | my @search_path; |
48 | my ($sp_string) = $dbh->selectrow_array('SHOW search_path'); |
49 | while( $sp_string =~ s/("[^"]+"|[^,]+),?// ) { |
50 | unless( defined $1 and length $1 ) { |
51 | $self->throw_exception("search path sanity check failed: '$1'") |
52 | } |
53 | push @search_path, $1; |
54 | } |
55 | \@search_path |
56 | }; |
57 | } |
58 | |
d4f16b21 |
59 | sub _dbh_get_autoinc_seq { |
c01a6b75 |
60 | my ($self, $dbh, $schema, $table, $col) = @_; |
0680ac39 |
61 | |
7dfe289b |
62 | # get the list of postgres schemas to search. if we have a schema |
63 | # specified, use that. otherwise, use the search path |
64 | my @search_path; |
65 | if( defined $schema and length $schema ) { |
66 | @search_path = ( $schema ); |
67 | } else { |
1ff9c30d |
68 | @search_path = @{ $self->_get_pg_search_path($dbh) }; |
7dfe289b |
69 | } |
70 | |
c01a6b75 |
71 | # find the sequence(s) of the column in question (should have nextval declared on it) |
72 | my @sequence_names; |
7dfe289b |
73 | foreach my $search_schema (@search_path) { |
c01a6b75 |
74 | my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref; |
75 | if($info && defined $info->{COLUMN_DEF} |
76 | && $info->{COLUMN_DEF} =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i |
77 | ) { |
78 | push @sequence_names, $1; |
79 | } |
0680ac39 |
80 | } |
c01a6b75 |
81 | |
82 | if (@sequence_names != 1) { |
83 | $self->throw_exception (sprintf |
84 | q|Unable to reliably determine autoinc sequence name for '%s'.'%s' (possible candidates: %s)|, |
85 | $table, |
86 | $col, |
87 | join (', ', (@sequence_names ? @sequence_names : 'none found') ), |
88 | ); |
89 | } |
90 | |
91 | my $seq = $sequence_names[0]; |
92 | |
93 | if( $seq !~ /\./ ) { |
94 | my $sth = $dbh->prepare ( |
95 | 'SELECT * FROM "information_schema"."sequences" WHERE "sequence_name" = ?' |
96 | ); |
97 | $sth->execute ($seq); |
98 | |
99 | my @seen_in_schemas; |
100 | while (my $h = $sth->fetchrow_hashref) { |
101 | push @seen_in_schemas, $h->{sequence_schema}; |
102 | } |
103 | |
104 | if (not @seen_in_schemas) { |
105 | $self->throw_exception (sprintf |
106 | q|Automatically determined autoinc sequence name '%s' for '%s'.'%s' does not seem to exist...'|, |
107 | $seq, |
108 | $table, |
109 | $col, |
110 | ); |
111 | } |
112 | elsif (@seen_in_schemas > 1) { |
113 | $self->throw_exception (sprintf |
114 | q|Unable to reliably fully-qualify automatically determined autoinc sequence name '%s' for '%s'.'%s' (same name exist in schemas: %s)|, |
115 | $seq, |
116 | $table, |
117 | $col, |
118 | join (', ', (@seen_in_schemas)), |
119 | ); |
120 | } |
121 | else { |
122 | my $sql_maker = $self->sql_maker; |
123 | $seq = join ('.', map { $sql_maker->_quote ($_) } ($seen_in_schemas[0], $seq) ); |
124 | } |
125 | } |
126 | |
127 | return $seq; |
843f8ecd |
128 | } |
129 | |
130 | sub get_autoinc_seq { |
ca48cd7d |
131 | my ($self,$source,$col) = @_; |
d4daee7b |
132 | |
80625830 |
133 | my $schema; |
134 | my $table = $source->name; |
135 | |
136 | if (ref $table eq 'SCALAR') { |
137 | $table = $$table; |
138 | } |
139 | elsif ($table =~ /^(.+)\.(.+)$/) { |
140 | ($schema, $table) = ($1, $2); |
141 | } |
a9f32dbc |
142 | |
c01a6b75 |
143 | $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, $col); |
843f8ecd |
144 | } |
145 | |
4f533e8c |
146 | sub sqlt_type { |
147 | return 'PostgreSQL'; |
148 | } |
149 | |
45fa8288 |
150 | sub datetime_parser_type { return "DateTime::Format::Pg"; } |
151 | |
a71859b4 |
152 | sub bind_attribute_by_data_type { |
153 | my ($self,$data_type) = @_; |
154 | |
155 | my $bind_attributes = { |
eda28767 |
156 | bytea => { pg_type => DBD::Pg::PG_BYTEA }, |
5ba88f68 |
157 | blob => { pg_type => DBD::Pg::PG_BYTEA }, |
a71859b4 |
158 | }; |
d4daee7b |
159 | |
a71859b4 |
160 | if( defined $bind_attributes->{$data_type} ) { |
9fdf90df |
161 | return $bind_attributes->{$data_type}; |
a71859b4 |
162 | } |
163 | else { |
164 | return; |
165 | } |
166 | } |
167 | |
f04b2839 |
168 | sub _sequence_fetch { |
169 | my ( $self, $type, $seq ) = @_; |
9ae966b9 |
170 | my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')"); |
f04b2839 |
171 | return $id; |
172 | } |
173 | |
adb3554a |
174 | sub _svp_begin { |
eeb8cfeb |
175 | my ($self, $name) = @_; |
adb3554a |
176 | |
9ae966b9 |
177 | $self->_get_dbh->pg_savepoint($name); |
adb3554a |
178 | } |
179 | |
180 | sub _svp_release { |
eeb8cfeb |
181 | my ($self, $name) = @_; |
adb3554a |
182 | |
9ae966b9 |
183 | $self->_get_dbh->pg_release($name); |
adb3554a |
184 | } |
185 | |
186 | sub _svp_rollback { |
eeb8cfeb |
187 | my ($self, $name) = @_; |
adb3554a |
188 | |
9ae966b9 |
189 | $self->_get_dbh->pg_rollback_to($name); |
adb3554a |
190 | } |
191 | |
843f8ecd |
192 | 1; |
193 | |
75d07914 |
194 | =head1 NAME |
843f8ecd |
195 | |
196 | DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL |
197 | |
198 | =head1 SYNOPSIS |
199 | |
200 | # In your table classes |
201 | __PACKAGE__->load_components(qw/PK::Auto Core/); |
202 | __PACKAGE__->set_primary_key('id'); |
203 | __PACKAGE__->sequence('mysequence'); |
204 | |
205 | =head1 DESCRIPTION |
206 | |
207 | This class implements autoincrements for PostgreSQL. |
208 | |
7c0176a1 |
209 | =head1 POSTGRESQL SCHEMA SUPPORT |
210 | |
211 | This supports multiple PostgreSQL schemas, with one caveat: for |
212 | performance reasons, the schema search path is queried the first time it is |
213 | needed and CACHED for subsequent uses. |
214 | |
215 | For this reason, you should do any necessary manipulation of the |
216 | PostgreSQL search path BEFORE instantiating your schema object, or as |
217 | part of the on_connect_do option to connect(), for example: |
218 | |
219 | my $schema = My::Schema->connect |
220 | ( $dsn,$user,$pass, |
221 | { on_connect_do => |
222 | [ 'SET search_path TO myschema, foo, public' ], |
223 | }, |
224 | ); |
225 | |
7ff926e6 |
226 | =head1 AUTHORS |
7c0176a1 |
227 | |
7ff926e6 |
228 | See L<DBIx::Class/CONTRIBUTORS> |
843f8ecd |
229 | |
230 | =head1 LICENSE |
231 | |
232 | You may distribute this code under the same terms as Perl itself. |
233 | |
234 | =cut |