← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:15 2021

Filename/usr/local/libexec/sympa/Sympa/DatabaseDriver/PostgreSQL.pm
StatementsExecuted 11027 statements in 42.7ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
27542123.4ms1.02sSympa::DatabaseDriver::PostgreSQL::::do_prepared_querySympa::DatabaseDriver::PostgreSQL::do_prepared_query
2754119.43ms13.6msSympa::DatabaseDriver::PostgreSQL::::CORE:matchSympa::DatabaseDriver::PostgreSQL::CORE:match (opcode)
11133µs7.79msSympa::DatabaseDriver::PostgreSQL::::connectSympa::DatabaseDriver::PostgreSQL::connect
1115µs5µsSympa::DatabaseDriver::PostgreSQL::::build_connect_stringSympa::DatabaseDriver::PostgreSQL::build_connect_string
111600ns600nsSympa::DatabaseDriver::PostgreSQL::::required_modulesSympa::DatabaseDriver::PostgreSQL::required_modules (xsub)
0000s0sSympa::DatabaseDriver::PostgreSQL::::AS_BLOBSympa::DatabaseDriver::PostgreSQL::AS_BLOB
0000s0sSympa::DatabaseDriver::PostgreSQL::::AS_DOUBLESympa::DatabaseDriver::PostgreSQL::AS_DOUBLE
0000s0sSympa::DatabaseDriver::PostgreSQL::::BEGIN@30Sympa::DatabaseDriver::PostgreSQL::BEGIN@30
0000s0sSympa::DatabaseDriver::PostgreSQL::::BEGIN@31Sympa::DatabaseDriver::PostgreSQL::BEGIN@31
0000s0sSympa::DatabaseDriver::PostgreSQL::::BEGIN@32Sympa::DatabaseDriver::PostgreSQL::BEGIN@32
0000s0sSympa::DatabaseDriver::PostgreSQL::::BEGIN@34Sympa::DatabaseDriver::PostgreSQL::BEGIN@34
0000s0sSympa::DatabaseDriver::PostgreSQL::::BEGIN@36Sympa::DatabaseDriver::PostgreSQL::BEGIN@36
0000s0sSympa::DatabaseDriver::PostgreSQL::::BEGIN@40Sympa::DatabaseDriver::PostgreSQL::BEGIN@40
0000s0sSympa::DatabaseDriver::PostgreSQL::::__ANON__Sympa::DatabaseDriver::PostgreSQL::__ANON__ (xsub)
0000s0sSympa::DatabaseDriver::PostgreSQL::::add_fieldSympa::DatabaseDriver::PostgreSQL::add_field
0000s0sSympa::DatabaseDriver::PostgreSQL::::add_tableSympa::DatabaseDriver::PostgreSQL::add_table
0000s0sSympa::DatabaseDriver::PostgreSQL::::delete_fieldSympa::DatabaseDriver::PostgreSQL::delete_field
0000s0sSympa::DatabaseDriver::PostgreSQL::::get_fieldsSympa::DatabaseDriver::PostgreSQL::get_fields
0000s0sSympa::DatabaseDriver::PostgreSQL::::get_indexesSympa::DatabaseDriver::PostgreSQL::get_indexes
0000s0sSympa::DatabaseDriver::PostgreSQL::::get_primary_keySympa::DatabaseDriver::PostgreSQL::get_primary_key
0000s0sSympa::DatabaseDriver::PostgreSQL::::get_substring_clauseSympa::DatabaseDriver::PostgreSQL::get_substring_clause
0000s0sSympa::DatabaseDriver::PostgreSQL::::get_tablesSympa::DatabaseDriver::PostgreSQL::get_tables
0000s0sSympa::DatabaseDriver::PostgreSQL::::is_autoincSympa::DatabaseDriver::PostgreSQL::is_autoinc
0000s0sSympa::DatabaseDriver::PostgreSQL::::quoteSympa::DatabaseDriver::PostgreSQL::quote
0000s0sSympa::DatabaseDriver::PostgreSQL::::set_autoincSympa::DatabaseDriver::PostgreSQL::set_autoinc
0000s0sSympa::DatabaseDriver::PostgreSQL::::set_indexSympa::DatabaseDriver::PostgreSQL::set_index
0000s0sSympa::DatabaseDriver::PostgreSQL::::set_primary_keySympa::DatabaseDriver::PostgreSQL::set_primary_key
0000s0sSympa::DatabaseDriver::PostgreSQL::::translate_typeSympa::DatabaseDriver::PostgreSQL::translate_type
0000s0sSympa::DatabaseDriver::PostgreSQL::::unset_indexSympa::DatabaseDriver::PostgreSQL::unset_index
0000s0sSympa::DatabaseDriver::PostgreSQL::::unset_primary_keySympa::DatabaseDriver::PostgreSQL::unset_primary_key
0000s0sSympa::DatabaseDriver::PostgreSQL::::update_fieldSympa::DatabaseDriver::PostgreSQL::update_field
Call graph for these subroutines as a Graphviz dot language file.
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
28package Sympa::DatabaseDriver::PostgreSQL;
29
30use strict;
31use warnings;
32use Encode qw();
33
34use Sympa::Log;
35
36use base qw(Sympa::DatabaseDriver);
37
38my $log = Sympa::Log->instance;
39
40use 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
sub build_connect_string {
431300ns my $self = shift;
44
45 my $connect_string =
46 'DBI:Pg:dbname='
47 . $self->{'db_name'}
48 . ';host='
4911µs . ($self->{'db_host'} || 'localhost');
50 $connect_string .= ';port=' . $self->{'db_port'}
5111µs if defined $self->{'db_port'};
52 $connect_string .= ';' . $self->{'db_options'}
531700ns if defined $self->{'db_options'};
5412µ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
sub connect {
581900ns my $self = shift;
59
60110µs17.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.
6619µs25µ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
671115µs2109µ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
68150µs248µ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
7013µs return 1;
71}
72
73sub 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
sub do_prepared_query {
882754740µs my $self = shift;
892754756µ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.
93275422.8ms550817.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 }
105275418.2ms2754985ms return $self->SUPER::do_prepared_query($query, @_);
# spent 985ms making 2754 calls to Sympa::Database::do_prepared_query, avg 358µs/call
106}
107
108sub 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
128sub 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
158sub 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'.
210sub 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
248sub 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
263sub 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
295sub 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
344sub 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
382sub 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
408sub 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
434sub 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
488sub 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
527sub 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
579sub 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
599sub 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
633sub 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
654sub AS_DOUBLE {
655 return ({'pg_type' => DBD::Pg::PG_FLOAT8()} => $_[1])
656 if scalar @_ > 1;
657 return ();
658}
659
660sub AS_BLOB {
661 return ({'pg_type' => DBD::Pg::PG_BYTEA()} => $_[1])
662 if scalar @_ > 1;
663 return ();
664}
665
6661;
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
sub Sympa::DatabaseDriver::PostgreSQL::CORE:match; # opcode
# 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
sub Sympa::DatabaseDriver::PostgreSQL::required_modules; # xsub