Filename | /usr/local/libexec/sympa/Sympa/DatabaseDriver/PostgreSQL.pm |
Statements | Executed 11027 statements in 42.7ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2754 | 2 | 1 | 23.4ms | 1.02s | do_prepared_query | Sympa::DatabaseDriver::PostgreSQL::
2754 | 1 | 1 | 9.43ms | 13.6ms | CORE:match (opcode) | Sympa::DatabaseDriver::PostgreSQL::
1 | 1 | 1 | 33µs | 7.79ms | connect | Sympa::DatabaseDriver::PostgreSQL::
1 | 1 | 1 | 5µs | 5µs | build_connect_string | Sympa::DatabaseDriver::PostgreSQL::
1 | 1 | 1 | 600ns | 600ns | required_modules (xsub) | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | AS_BLOB | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | AS_DOUBLE | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | BEGIN@30 | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | BEGIN@36 | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | BEGIN@40 | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | add_field | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | add_table | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | delete_field | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | get_fields | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | get_indexes | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | get_primary_key | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | get_substring_clause | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | get_tables | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | is_autoinc | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | quote | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | set_autoinc | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | set_index | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | set_primary_key | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | translate_type | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | unset_index | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | unset_primary_key | Sympa::DatabaseDriver::PostgreSQL::
0 | 0 | 0 | 0s | 0s | update_field | Sympa::DatabaseDriver::PostgreSQL::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # -*- indent-tabs-mode: nil; -*- | ||||
2 | # vim:ft=perl:et:sw=4 | ||||
3 | # $Id$ | ||||
4 | |||||
5 | # Sympa - SYsteme de Multi-Postage Automatique | ||||
6 | # | ||||
7 | # Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel | ||||
8 | # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, | ||||
9 | # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites | ||||
10 | # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER | ||||
11 | # Copyright 2018 The Sympa Community. See the AUTHORS.md file at the | ||||
12 | # top-level directory of this distribution and at | ||||
13 | # <https://github.com/sympa-community/sympa.git>. | ||||
14 | # | ||||
15 | # This program is free software; you can redistribute it and/or modify | ||||
16 | # it under the terms of the GNU General Public License as published by | ||||
17 | # the Free Software Foundation; either version 2 of the License, or | ||||
18 | # (at your option) any later version. | ||||
19 | # | ||||
20 | # This program is distributed in the hope that it will be useful, | ||||
21 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
22 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
23 | # GNU General Public License for more details. | ||||
24 | # | ||||
25 | # You should have received a copy of the GNU General Public License | ||||
26 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||
27 | |||||
28 | package Sympa::DatabaseDriver::PostgreSQL; | ||||
29 | |||||
30 | use strict; | ||||
31 | use warnings; | ||||
32 | use Encode qw(); | ||||
33 | |||||
34 | use Sympa::Log; | ||||
35 | |||||
36 | use base qw(Sympa::DatabaseDriver); | ||||
37 | |||||
38 | my $log = Sympa::Log->instance; | ||||
39 | |||||
40 | use constant required_modules => [qw(DBD::Pg)]; | ||||
41 | |||||
42 | # spent 5µs within Sympa::DatabaseDriver::PostgreSQL::build_connect_string which was called:
# once (5µs+0s) by Sympa::Database::_connect at line 198 of /usr/local/libexec/sympa/Sympa/Database.pm | ||||
43 | 1 | 300ns | my $self = shift; | ||
44 | |||||
45 | my $connect_string = | ||||
46 | 'DBI:Pg:dbname=' | ||||
47 | . $self->{'db_name'} | ||||
48 | . ';host=' | ||||
49 | 1 | 1µs | . ($self->{'db_host'} || 'localhost'); | ||
50 | $connect_string .= ';port=' . $self->{'db_port'} | ||||
51 | 1 | 1µs | if defined $self->{'db_port'}; | ||
52 | $connect_string .= ';' . $self->{'db_options'} | ||||
53 | 1 | 700ns | if defined $self->{'db_options'}; | ||
54 | 1 | 2µs | return $connect_string; | ||
55 | } | ||||
56 | |||||
57 | # spent 7.79ms (33µs+7.76) within Sympa::DatabaseDriver::PostgreSQL::connect which was called:
# once (33µs+7.76ms) by Sympa::Database::do_prepared_query at line 353 of /usr/local/libexec/sympa/Sympa/Database.pm | ||||
58 | 1 | 900ns | my $self = shift; | ||
59 | |||||
60 | 1 | 10µs | 1 | 7.59ms | $self->SUPER::connect() or return undef; # spent 7.59ms making 1 call to Sympa::Database::connect |
61 | |||||
62 | # - Configure Postgres to use ISO format dates. | ||||
63 | # - Set client encoding to UTF8. | ||||
64 | # Note: utf8 flagging must be disabled so that we will consistently use | ||||
65 | # UTF-8 bytestring as internal format. | ||||
66 | 1 | 9µs | 2 | 5µs | $self->__dbh->{pg_enable_utf8} = 0; # For DBD::Pg 3.x # spent 3µs making 1 call to DBI::common::STORE
# spent 2µs making 1 call to Sympa::Database::__dbh |
67 | 1 | 115µs | 2 | 109µs | $self->__dbh->do("SET DATESTYLE TO 'ISO';"); # spent 109µs making 1 call to DBI::db::do
# spent 900ns making 1 call to Sympa::Database::__dbh |
68 | 1 | 50µs | 2 | 48µs | $self->__dbh->do("SET NAMES 'utf8'"); # spent 46µs making 1 call to DBI::db::do
# spent 1µs making 1 call to Sympa::Database::__dbh |
69 | |||||
70 | 1 | 3µs | return 1; | ||
71 | } | ||||
72 | |||||
73 | sub quote { | ||||
74 | my $self = shift; | ||||
75 | my $string = shift; | ||||
76 | my $data_type = shift; | ||||
77 | |||||
78 | # Set utf8 flag. Because DBD::Pg 3.3.0 to 3.5.x need utf8 flag for input | ||||
79 | # parameters, even if pg_enable_utf8 option is disabled. | ||||
80 | if ($DBD::Pg::VERSION =~ /\A3[.][3-5]\b/ | ||||
81 | and not(ref $data_type eq 'HASH' and $data_type->{pg_type})) { | ||||
82 | $string = Encode::decode_utf8($string); | ||||
83 | } | ||||
84 | return $self->SUPER::quote($string, $data_type); | ||||
85 | } | ||||
86 | |||||
87 | # spent 1.02s (23.4ms+998ms) within Sympa::DatabaseDriver::PostgreSQL::do_prepared_query which was called 2754 times, avg 371µs/call:
# 1377 times (12.2ms+561ms) by Sympa::List::has_included_users at line 5789 of /usr/local/libexec/sympa/Sympa/List.pm, avg 416µs/call
# 1377 times (11.1ms+438ms) by Sympa::List::has_included_users at line 5804 of /usr/local/libexec/sympa/Sympa/List.pm, avg 326µs/call | ||||
88 | 2754 | 740µs | my $self = shift; | ||
89 | 2754 | 756µs | my $query = shift; | ||
90 | |||||
91 | # Set utf8 flag. Because DBD::Pg 3.3.0 to 3.5.x need utf8 flag for input | ||||
92 | # parameters, even if pg_enable_utf8 option is disabled. | ||||
93 | 2754 | 22.8ms | 5508 | 17.8ms | if ($DBD::Pg::VERSION =~ /\A3[.][3-5]\b/) { # spent 13.6ms making 2754 calls to Sympa::DatabaseDriver::PostgreSQL::CORE:match, avg 5µs/call
# spent 4.19ms making 2754 calls to version::("", avg 2µs/call |
94 | my @params; | ||||
95 | while (scalar @_) { | ||||
96 | my $p = shift; | ||||
97 | if (ref $p) { | ||||
98 | push @params, $p, shift; | ||||
99 | } else { | ||||
100 | push @params, Encode::decode_utf8($p); | ||||
101 | } | ||||
102 | } | ||||
103 | @_ = @params; | ||||
104 | } | ||||
105 | 2754 | 18.2ms | 2754 | 985ms | return $self->SUPER::do_prepared_query($query, @_); # spent 985ms making 2754 calls to Sympa::Database::do_prepared_query, avg 358µs/call |
106 | } | ||||
107 | |||||
108 | sub get_substring_clause { | ||||
109 | my $self = shift; | ||||
110 | my $param = shift; | ||||
111 | $log->syslog('debug2', 'Building a substring clause'); | ||||
112 | return | ||||
113 | "SUBSTRING(" | ||||
114 | . $param->{'source_field'} | ||||
115 | . " FROM position('" | ||||
116 | . $param->{'separator'} . "' IN " | ||||
117 | . $param->{'source_field'} | ||||
118 | . ") FOR " | ||||
119 | . $param->{'substring_length'} . ")"; | ||||
120 | } | ||||
121 | |||||
122 | # DEPRECATED. | ||||
123 | #sub get_limit_clause ( { rows_count => $rows, offset => $offset } ); | ||||
124 | |||||
125 | # DEPRECATED. | ||||
126 | #sub get_formatted_date; | ||||
127 | |||||
128 | sub is_autoinc { | ||||
129 | my $self = shift; | ||||
130 | my $param = shift; | ||||
131 | $log->syslog('debug', 'Checking whether field %s.%s is an autoincrement', | ||||
132 | $param->{'table'}, $param->{'field'}); | ||||
133 | my $seqname = $param->{'table'} . '_' . $param->{'field'} . '_seq'; | ||||
134 | my $sth; | ||||
135 | unless ( | ||||
136 | $sth = $self->do_prepared_query( | ||||
137 | q{SELECT relname | ||||
138 | FROM pg_class | ||||
139 | WHERE relname = ? AND relkind = 'S' AND | ||||
140 | relnamespace IN ( | ||||
141 | SELECT oid | ||||
142 | FROM pg_namespace | ||||
143 | WHERE nspname NOT LIKE 'pg_%' AND | ||||
144 | nspname != 'information_schema' | ||||
145 | )}, | ||||
146 | $seqname | ||||
147 | ) | ||||
148 | ) { | ||||
149 | $log->syslog('err', | ||||
150 | 'Unable to gather autoincrement field named %s for table %s', | ||||
151 | $param->{'field'}, $param->{'table'}); | ||||
152 | return undef; | ||||
153 | } | ||||
154 | my $field = $sth->fetchrow(); | ||||
155 | return ($field eq $seqname); | ||||
156 | } | ||||
157 | |||||
158 | sub set_autoinc { | ||||
159 | my $self = shift; | ||||
160 | my $param = shift; | ||||
161 | $log->syslog('debug', 'Setting field %s.%s as an auto increment', | ||||
162 | $param->{'table'}, $param->{'field'}); | ||||
163 | my $seqname = $param->{'table'} . '_' . $param->{'field'} . '_seq'; | ||||
164 | unless ($self->do_query("CREATE SEQUENCE %s", $seqname)) { | ||||
165 | $log->syslog('err', 'Unable to create sequence %s', $seqname); | ||||
166 | return undef; | ||||
167 | } | ||||
168 | unless ( | ||||
169 | $self->do_query( | ||||
170 | "ALTER TABLE %s ALTER COLUMN %s TYPE BIGINT", $param->{'table'}, | ||||
171 | $param->{'field'} | ||||
172 | ) | ||||
173 | ) { | ||||
174 | $log->syslog('err', | ||||
175 | 'Unable to set type of field %s in table %s as bigint', | ||||
176 | $param->{'field'}, $param->{'table'}); | ||||
177 | return undef; | ||||
178 | } | ||||
179 | unless ( | ||||
180 | $self->do_query( | ||||
181 | "ALTER TABLE %s ALTER COLUMN %s SET DEFAULT NEXTVAL('%s')", | ||||
182 | $param->{'table'}, $param->{'field'}, $seqname | ||||
183 | ) | ||||
184 | ) { | ||||
185 | $log->syslog( | ||||
186 | 'err', | ||||
187 | 'Unable to set default value of field %s in table %s as next value of sequence table %s', | ||||
188 | $param->{'field'}, | ||||
189 | $param->{'table'}, | ||||
190 | $seqname | ||||
191 | ); | ||||
192 | return undef; | ||||
193 | } | ||||
194 | unless ( | ||||
195 | $self->do_query( | ||||
196 | "UPDATE %s SET %s = NEXTVAL('%s')", $param->{'table'}, | ||||
197 | $param->{'field'}, $seqname | ||||
198 | ) | ||||
199 | ) { | ||||
200 | $log->syslog('err', | ||||
201 | 'Unable to set sequence %s as value for field %s, table %s', | ||||
202 | $seqname, $param->{'field'}, $param->{'table'}); | ||||
203 | return undef; | ||||
204 | } | ||||
205 | return 1; | ||||
206 | } | ||||
207 | |||||
208 | # Note: Pg searches tables in schemas listed in search_path, defaults to be | ||||
209 | # '"$user",public'. | ||||
210 | sub get_tables { | ||||
211 | my $self = shift; | ||||
212 | $log->syslog('debug3', 'Getting the list of tables in database %s', | ||||
213 | $self->{'db_name'}); | ||||
214 | |||||
215 | ## get search_path. | ||||
216 | ## The result is an arrayref; needs DBD::Pg >= 2.00 and PostgreSQL > 7.4. | ||||
217 | my $sth; | ||||
218 | unless ($sth = $self->do_query('SELECT current_schemas(false)')) { | ||||
219 | $log->syslog('err', 'Unable to get search_path of database %s', | ||||
220 | $self->{'db_name'}); | ||||
221 | return undef; | ||||
222 | } | ||||
223 | my $search_path = $sth->fetchrow; | ||||
224 | $sth->finish; | ||||
225 | |||||
226 | ## get table names. | ||||
227 | my @raw_tables; | ||||
228 | my %raw_tables; | ||||
229 | foreach my $schema (@{$search_path || []}) { | ||||
230 | my @tables = | ||||
231 | $self->__dbh->tables(undef, $schema, undef, 'TABLE', | ||||
232 | {pg_noprefix => 1}); | ||||
233 | foreach my $t (@tables) { | ||||
234 | next if $raw_tables{$t}; | ||||
235 | push @raw_tables, $t; | ||||
236 | $raw_tables{$t} = 1; | ||||
237 | } | ||||
238 | } | ||||
239 | unless (@raw_tables) { | ||||
240 | $log->syslog('err', | ||||
241 | 'Unable to retrieve the list of tables from database %s', | ||||
242 | $self->{'db_name'}); | ||||
243 | return undef; | ||||
244 | } | ||||
245 | return \@raw_tables; | ||||
246 | } | ||||
247 | |||||
248 | sub add_table { | ||||
249 | my $self = shift; | ||||
250 | my $param = shift; | ||||
251 | $log->syslog('debug', 'Adding table %s', $param->{'table'}); | ||||
252 | unless ( | ||||
253 | $self->do_query("CREATE TABLE %s (temporary INT)", $param->{'table'})) | ||||
254 | { | ||||
255 | $log->syslog('err', 'Could not create table %s in database %s', | ||||
256 | $param->{'table'}, $self->{'db_name'}); | ||||
257 | return undef; | ||||
258 | } | ||||
259 | return sprintf "Table %s created in database %s", $param->{'table'}, | ||||
260 | $self->{'db_name'}; | ||||
261 | } | ||||
262 | |||||
263 | sub get_fields { | ||||
264 | my $self = shift; | ||||
265 | my $param = shift; | ||||
266 | $log->syslog('debug', | ||||
267 | 'Getting the list of fields in table %s, database %s', | ||||
268 | $param->{'table'}, $self->{'db_name'}); | ||||
269 | my $sth; | ||||
270 | my %result; | ||||
271 | unless ( | ||||
272 | $sth = $self->do_query( | ||||
273 | "SELECT a.attname AS field, t.typname AS type, a.atttypmod AS length FROM pg_class c, pg_attribute a, pg_type t WHERE a.attnum > 0 and a.attrelid = c.oid and c.relname = '%s' and a.atttypid = t.oid order by a.attnum", | ||||
274 | $param->{'table'} | ||||
275 | ) | ||||
276 | ) { | ||||
277 | $log->syslog('err', | ||||
278 | 'Could not get the list of fields from table %s in database %s', | ||||
279 | $param->{'table'}, $self->{'db_name'}); | ||||
280 | return undef; | ||||
281 | } | ||||
282 | while (my $ref = $sth->fetchrow_hashref('NAME_lc')) { | ||||
283 | # What a dirty method ! We give a Sympa tee shirt to anyone that | ||||
284 | # suggest a clean solution ;-) | ||||
285 | my $length = $ref->{'length'} - 4; | ||||
286 | if ($ref->{'type'} eq 'varchar') { | ||||
287 | $result{$ref->{'field'}} = $ref->{'type'} . '(' . $length . ')'; | ||||
288 | } else { | ||||
289 | $result{$ref->{'field'}} = $ref->{'type'}; | ||||
290 | } | ||||
291 | } | ||||
292 | return \%result; | ||||
293 | } | ||||
294 | |||||
295 | sub update_field { | ||||
296 | my $self = shift; | ||||
297 | my $param = shift; | ||||
298 | my $table = $param->{'table'}; | ||||
299 | my $field = $param->{'field'}; | ||||
300 | my $type = $param->{'type'}; | ||||
301 | $log->syslog('debug3', 'Updating field %s in table %s (%s, %s)', | ||||
302 | $field, $table, $type, $param->{'notnull'}); | ||||
303 | my $options = ''; | ||||
304 | if ($param->{'notnull'}) { | ||||
305 | $options .= ' NOT NULL '; | ||||
306 | } | ||||
307 | my $report; | ||||
308 | my @sql; | ||||
309 | |||||
310 | ## Conversion between timestamp and integer is not obvious. | ||||
311 | ## So create new column then copy contents. | ||||
312 | my $fields = $self->get_fields({'table' => $table}); | ||||
313 | if ($fields->{$field} eq 'timestamptz' and $type =~ /^int/i) { | ||||
314 | @sql = ( | ||||
315 | "ALTER TABLE $table RENAME $field TO ${field}_tmp", | ||||
316 | "ALTER TABLE $table ADD $field $type$options", | ||||
317 | "UPDATE $table SET $field = date_part('epoch', ${field}_tmp)", | ||||
318 | "ALTER TABLE $table DROP ${field}_tmp" | ||||
319 | ); | ||||
320 | } else { | ||||
321 | @sql = sprintf("ALTER TABLE %s ALTER COLUMN %s TYPE %s %s", | ||||
322 | $table, $field, $type, $options); | ||||
323 | } | ||||
324 | foreach my $sql (@sql) { | ||||
325 | $log->syslog('notice', '%s', $sql); | ||||
326 | if ($report) { | ||||
327 | $report .= "\n$sql"; | ||||
328 | } else { | ||||
329 | $report = $sql; | ||||
330 | } | ||||
331 | unless ($self->do_query('%s', $sql)) { | ||||
332 | $log->syslog('err', 'Could not change field "%s" in table "%s"', | ||||
333 | $param->{'field'}, $param->{'table'}); | ||||
334 | return undef; | ||||
335 | } | ||||
336 | } | ||||
337 | $report .= | ||||
338 | sprintf("\nField %s in table %s, structure updated", $field, $table); | ||||
339 | $log->syslog('info', 'Field %s in table %s, structure updated', | ||||
340 | $field, $table); | ||||
341 | return $report; | ||||
342 | } | ||||
343 | |||||
344 | sub add_field { | ||||
345 | my $self = shift; | ||||
346 | my $param = shift; | ||||
347 | $log->syslog( | ||||
348 | 'debug', 'Adding field %s in table %s (%s, %s, %s, %s)', | ||||
349 | $param->{'field'}, $param->{'table'}, | ||||
350 | $param->{'type'}, $param->{'notnull'}, | ||||
351 | $param->{'autoinc'}, $param->{'primary'} | ||||
352 | ); | ||||
353 | my $options = ''; | ||||
354 | # To prevent "Cannot add a NOT NULL column with default value NULL" errors | ||||
355 | if ($param->{'notnull'}) { | ||||
356 | $options .= 'NOT NULL '; | ||||
357 | } | ||||
358 | if ($param->{'primary'}) { | ||||
359 | $options .= ' PRIMARY KEY '; | ||||
360 | } | ||||
361 | unless ( | ||||
362 | $self->do_query( | ||||
363 | "ALTER TABLE %s ADD %s %s %s", $param->{'table'}, | ||||
364 | $param->{'field'}, $param->{'type'}, | ||||
365 | $options | ||||
366 | ) | ||||
367 | ) { | ||||
368 | $log->syslog('err', | ||||
369 | 'Could not add field %s to table %s in database %s', | ||||
370 | $param->{'field'}, $param->{'table'}, $self->{'db_name'}); | ||||
371 | return undef; | ||||
372 | } | ||||
373 | |||||
374 | my $report = sprintf('Field %s added to table %s (options : %s)', | ||||
375 | $param->{'field'}, $param->{'table'}, $options); | ||||
376 | $log->syslog('info', 'Field %s added to table %s (options: %s)', | ||||
377 | $param->{'field'}, $param->{'table'}, $options); | ||||
378 | |||||
379 | return $report; | ||||
380 | } | ||||
381 | |||||
382 | sub delete_field { | ||||
383 | my $self = shift; | ||||
384 | my $param = shift; | ||||
385 | $log->syslog('debug', 'Deleting field %s from table %s', | ||||
386 | $param->{'field'}, $param->{'table'}); | ||||
387 | |||||
388 | unless ( | ||||
389 | $self->do_query( | ||||
390 | "ALTER TABLE %s DROP COLUMN %s", $param->{'table'}, | ||||
391 | $param->{'field'} | ||||
392 | ) | ||||
393 | ) { | ||||
394 | $log->syslog('err', | ||||
395 | 'Could not delete field %s from table %s in database %s', | ||||
396 | $param->{'field'}, $param->{'table'}, $self->{'db_name'}); | ||||
397 | return undef; | ||||
398 | } | ||||
399 | |||||
400 | my $report = sprintf('Field %s removed from table %s', | ||||
401 | $param->{'field'}, $param->{'table'}); | ||||
402 | $log->syslog('info', 'Field %s removed from table %s', | ||||
403 | $param->{'field'}, $param->{'table'}); | ||||
404 | |||||
405 | return $report; | ||||
406 | } | ||||
407 | |||||
408 | sub get_primary_key { | ||||
409 | my $self = shift; | ||||
410 | my $param = shift; | ||||
411 | |||||
412 | $log->syslog('debug', 'Getting primary key for table %s', | ||||
413 | $param->{'table'}); | ||||
414 | my %found_keys; | ||||
415 | my $sth; | ||||
416 | unless ( | ||||
417 | $sth = $self->do_query( | ||||
418 | "SELECT pg_attribute.attname AS field FROM pg_index, pg_class, pg_attribute WHERE pg_class.oid ='%s'::regclass AND indrelid = pg_class.oid AND pg_attribute.attrelid = pg_class.oid AND pg_attribute.attnum = any(pg_index.indkey) AND indisprimary", | ||||
419 | $param->{'table'} | ||||
420 | ) | ||||
421 | ) { | ||||
422 | $log->syslog('err', | ||||
423 | 'Could not get the primary key from table %s in database %s', | ||||
424 | $param->{'table'}, $self->{'db_name'}); | ||||
425 | return undef; | ||||
426 | } | ||||
427 | |||||
428 | while (my $ref = $sth->fetchrow_hashref('NAME_lc')) { | ||||
429 | $found_keys{$ref->{'field'}} = 1; | ||||
430 | } | ||||
431 | return \%found_keys; | ||||
432 | } | ||||
433 | |||||
434 | sub unset_primary_key { | ||||
435 | my $self = shift; | ||||
436 | my $param = shift; | ||||
437 | $log->syslog('debug', 'Removing primary key from table %s', | ||||
438 | $param->{'table'}); | ||||
439 | |||||
440 | my $sth; | ||||
441 | |||||
442 | ## PostgreSQL does not have 'ALTER TABLE ... DROP PRIMARY KEY'. | ||||
443 | ## Instead, get a name of constraint then drop it. | ||||
444 | my $key_name; | ||||
445 | |||||
446 | unless ( | ||||
447 | $sth = $self->do_query( | ||||
448 | q{SELECT tc.constraint_name | ||||
449 | FROM information_schema.table_constraints AS tc | ||||
450 | WHERE tc.table_catalog = %s AND tc.table_name = %s AND | ||||
451 | tc.constraint_type = 'PRIMARY KEY'}, | ||||
452 | $self->quote($self->{'db_name'}), $self->quote($param->{'table'}) | ||||
453 | ) | ||||
454 | ) { | ||||
455 | $log->syslog('err', | ||||
456 | 'Could not search primary key from table %s in database %s', | ||||
457 | $param->{'table'}, $self->{'db_name'}); | ||||
458 | return undef; | ||||
459 | } | ||||
460 | |||||
461 | $key_name = $sth->fetchrow_array(); | ||||
462 | $sth->finish; | ||||
463 | unless (defined $key_name) { | ||||
464 | $log->syslog('err', | ||||
465 | 'Could not get primary key from table %s in database %s', | ||||
466 | $param->{'table'}, $self->{'db_name'}); | ||||
467 | return undef; | ||||
468 | } | ||||
469 | |||||
470 | unless ( | ||||
471 | $sth = $self->do_query( | ||||
472 | q{ALTER TABLE %s DROP CONSTRAINT "%s"}, $param->{'table'}, | ||||
473 | $key_name | ||||
474 | ) | ||||
475 | ) { | ||||
476 | $log->syslog('err', | ||||
477 | 'Could not drop primary key "%s" from table %s in database %s', | ||||
478 | $key_name, $param->{'table'}, $self->{'db_name'}); | ||||
479 | return undef; | ||||
480 | } | ||||
481 | |||||
482 | my $report = "Table $param->{'table'}, PRIMARY KEY dropped"; | ||||
483 | $log->syslog('info', 'Table %s, PRIMARY KEY dropped', $param->{'table'}); | ||||
484 | |||||
485 | return $report; | ||||
486 | } | ||||
487 | |||||
488 | sub set_primary_key { | ||||
489 | my $self = shift; | ||||
490 | my $param = shift; | ||||
491 | |||||
492 | my $sth; | ||||
493 | |||||
494 | ## Give fixed key name if possible. | ||||
495 | my $key; | ||||
496 | if ($param->{'table'} =~ /^(.+)_table$/) { | ||||
497 | $key = sprintf 'CONSTRAINT "ind_%s" PRIMARY KEY', $1; | ||||
498 | } else { | ||||
499 | $key = 'PRIMARY KEY'; | ||||
500 | } | ||||
501 | |||||
502 | my $fields = join ',', @{$param->{'fields'}}; | ||||
503 | $log->syslog('debug', 'Setting primary key for table %s (%s)', | ||||
504 | $param->{'table'}, $fields); | ||||
505 | unless ( | ||||
506 | $sth = $self->do_query( | ||||
507 | q{ALTER TABLE %s ADD %s (%s)}, $param->{'table'}, | ||||
508 | $key, $fields | ||||
509 | ) | ||||
510 | ) { | ||||
511 | $log->syslog( | ||||
512 | 'err', | ||||
513 | 'Could not set fields %s as primary key for table %s in database %s', | ||||
514 | $fields, | ||||
515 | $param->{'table'}, | ||||
516 | $self->{'db_name'} | ||||
517 | ); | ||||
518 | return undef; | ||||
519 | } | ||||
520 | |||||
521 | my $report = "Table $param->{'table'}, PRIMARY KEY set on $fields"; | ||||
522 | $log->syslog('info', 'Table %s, PRIMARY KEY set on %s', | ||||
523 | $param->{'table'}, $fields); | ||||
524 | return $report; | ||||
525 | } | ||||
526 | |||||
527 | sub get_indexes { | ||||
528 | my $self = shift; | ||||
529 | my $param = shift; | ||||
530 | |||||
531 | $log->syslog('debug', 'Getting the indexes defined on table %s', | ||||
532 | $param->{'table'}); | ||||
533 | my %found_indexes; | ||||
534 | my $sth; | ||||
535 | unless ( | ||||
536 | $sth = $self->do_query( | ||||
537 | q{SELECT c.oid | ||||
538 | FROM pg_catalog.pg_class c LEFT JOIN pg_catalog.pg_namespace n | ||||
539 | ON n.oid = c.relnamespace | ||||
540 | WHERE c.relname ~ '^(%s)$' AND | ||||
541 | pg_catalog.pg_table_is_visible(c.oid)}, | ||||
542 | $param->{'table'} | ||||
543 | ) | ||||
544 | ) { | ||||
545 | $log->syslog('err', | ||||
546 | 'Could not get the oid for table %s in database %s', | ||||
547 | $param->{'table'}, $self->{'db_name'}); | ||||
548 | return undef; | ||||
549 | } | ||||
550 | my $ref = $sth->fetchrow_hashref('NAME_lc'); | ||||
551 | |||||
552 | unless ( | ||||
553 | $sth = $self->do_query( | ||||
554 | "SELECT c2.relname, pg_catalog.pg_get_indexdef(i.indexrelid, 0, true) AS description FROM pg_catalog.pg_class c, pg_catalog.pg_class c2, pg_catalog.pg_index i WHERE c.oid = \'%s\' AND c.oid = i.indrelid AND i.indexrelid = c2.oid AND NOT i.indisprimary ORDER BY i.indisprimary DESC, i.indisunique DESC, c2.relname", | ||||
555 | $ref->{'oid'} | ||||
556 | ) | ||||
557 | ) { | ||||
558 | $log->syslog( | ||||
559 | 'err', | ||||
560 | 'Could not get the list of indexes from table %s in database %s', | ||||
561 | $param->{'table'}, | ||||
562 | $self->{'db_name'} | ||||
563 | ); | ||||
564 | return undef; | ||||
565 | } | ||||
566 | |||||
567 | while (my $ref = $sth->fetchrow_hashref('NAME_lc')) { | ||||
568 | $ref->{'description'} =~ | ||||
569 | s/CREATE INDEX .* ON .* USING .* \((.*)\)$/$1/i; | ||||
570 | $ref->{'description'} =~ s/\s//i; | ||||
571 | my @index_members = split ',', $ref->{'description'}; | ||||
572 | foreach my $member (@index_members) { | ||||
573 | $found_indexes{$ref->{'relname'}}{$member} = 1; | ||||
574 | } | ||||
575 | } | ||||
576 | return \%found_indexes; | ||||
577 | } | ||||
578 | |||||
579 | sub unset_index { | ||||
580 | my $self = shift; | ||||
581 | my $param = shift; | ||||
582 | $log->syslog('debug', 'Removing index %s from table %s', | ||||
583 | $param->{'index'}, $param->{'table'}); | ||||
584 | |||||
585 | my $sth; | ||||
586 | unless ($sth = $self->do_query("DROP INDEX %s", $param->{'index'})) { | ||||
587 | $log->syslog('err', | ||||
588 | 'Could not drop index %s from table %s in database %s', | ||||
589 | $param->{'index'}, $param->{'table'}, $self->{'db_name'}); | ||||
590 | return undef; | ||||
591 | } | ||||
592 | my $report = "Table $param->{'table'}, index $param->{'index'} dropped"; | ||||
593 | $log->syslog('info', 'Table %s, index %s dropped', | ||||
594 | $param->{'table'}, $param->{'index'}); | ||||
595 | |||||
596 | return $report; | ||||
597 | } | ||||
598 | |||||
599 | sub set_index { | ||||
600 | my $self = shift; | ||||
601 | my $param = shift; | ||||
602 | |||||
603 | my $sth; | ||||
604 | my $fields = join ',', @{$param->{'fields'}}; | ||||
605 | $log->syslog( | ||||
606 | 'debug', | ||||
607 | 'Setting index %s for table %s using fields %s', | ||||
608 | $param->{'index_name'}, | ||||
609 | $param->{'table'}, $fields | ||||
610 | ); | ||||
611 | unless ( | ||||
612 | $sth = $self->do_query( | ||||
613 | "CREATE INDEX %s ON %s (%s)", $param->{'index_name'}, | ||||
614 | $param->{'table'}, $fields | ||||
615 | ) | ||||
616 | ) { | ||||
617 | $log->syslog( | ||||
618 | 'err', | ||||
619 | 'Could not add index %s using field %s for table %s in database %s', | ||||
620 | $fields, | ||||
621 | $param->{'table'}, | ||||
622 | $self->{'db_name'} | ||||
623 | ); | ||||
624 | return undef; | ||||
625 | } | ||||
626 | my $report = sprintf 'Table %s, index %s set using fields %s', | ||||
627 | $param->{'table'}, $param->{'index_name'}, $fields; | ||||
628 | $log->syslog('info', 'Table %s, index %s set using fields %s', | ||||
629 | $param->{'table'}, $param->{'index_name'}, $fields); | ||||
630 | return $report; | ||||
631 | } | ||||
632 | |||||
633 | sub translate_type { | ||||
634 | my $self = shift; | ||||
635 | my $type = shift; | ||||
636 | |||||
637 | return undef unless $type; | ||||
638 | |||||
639 | # PostgreSQL | ||||
640 | $type =~ s/^int(1)/smallint/g; | ||||
641 | $type =~ s/^int\(?.*\)?/int4/g; | ||||
642 | $type =~ s/^smallint.*/int4/g; | ||||
643 | $type =~ s/^tinyint\(.*\)/int2/g; | ||||
644 | $type =~ s/^bigint.*/int8/g; | ||||
645 | $type =~ s/^double/float8/g; | ||||
646 | $type =~ s/^text.*/text/g; # varchar(500) on <= 6.2.36 | ||||
647 | $type =~ s/^longtext.*/text/g; | ||||
648 | $type =~ s/^datetime.*/timestamptz/g; | ||||
649 | $type =~ s/^enum.*/varchar(15)/g; | ||||
650 | $type =~ s/^mediumblob/bytea/g; | ||||
651 | return $type; | ||||
652 | } | ||||
653 | |||||
654 | sub AS_DOUBLE { | ||||
655 | return ({'pg_type' => DBD::Pg::PG_FLOAT8()} => $_[1]) | ||||
656 | if scalar @_ > 1; | ||||
657 | return (); | ||||
658 | } | ||||
659 | |||||
660 | sub AS_BLOB { | ||||
661 | return ({'pg_type' => DBD::Pg::PG_BYTEA()} => $_[1]) | ||||
662 | if scalar @_ > 1; | ||||
663 | return (); | ||||
664 | } | ||||
665 | |||||
666 | 1; | ||||
667 | __END__ | ||||
# spent 13.6ms (9.43+4.19) within Sympa::DatabaseDriver::PostgreSQL::CORE:match which was called 2754 times, avg 5µs/call:
# 2754 times (9.43ms+4.19ms) by Sympa::DatabaseDriver::PostgreSQL::do_prepared_query at line 93, avg 5µs/call | |||||
# spent 600ns within Sympa::DatabaseDriver::PostgreSQL::required_modules which was called:
# once (600ns+0s) by Sympa::Database::connect at line 122 of /usr/local/libexec/sympa/Sympa/Database.pm |