Filename | /usr/local/libexec/sympa/Sympa/DatabaseManager.pm |
Statements | Executed 3444 statements in 3.77ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1722 | 2 | 1 | 3.05ms | 3.05ms | instance | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@27 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@28 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@30 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@33 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@35 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | BEGIN@36 | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | _check_db_field_type | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | _check_fields | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | _check_indexes | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | _check_key | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | _check_primary_key | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | _db_struct | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | disconnect | Sympa::DatabaseManager::
0 | 0 | 0 | 0s | 0s | probe_db | Sympa::DatabaseManager::
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 | # | ||||
12 | # This program is free software; you can redistribute it and/or modify | ||||
13 | # it under the terms of the GNU General Public License as published by | ||||
14 | # the Free Software Foundation; either version 2 of the License, or | ||||
15 | # (at your option) any later version. | ||||
16 | # | ||||
17 | # This program is distributed in the hope that it will be useful, | ||||
18 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
19 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
20 | # GNU General Public License for more details. | ||||
21 | # | ||||
22 | # You should have received a copy of the GNU General Public License | ||||
23 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||
24 | |||||
25 | package Sympa::DatabaseManager; | ||||
26 | |||||
27 | use strict; | ||||
28 | use warnings; | ||||
29 | |||||
30 | use Sympa; | ||||
31 | use Conf; | ||||
32 | use Sympa::Constants; | ||||
33 | use Sympa::Database; | ||||
34 | use Sympa::DatabaseDescription; | ||||
35 | use Sympa::Log; | ||||
36 | use Sympa::Tools::Data; | ||||
37 | |||||
38 | my $log = Sympa::Log->instance; | ||||
39 | |||||
40 | our $instance; | ||||
41 | |||||
42 | # NOTE: This method actually returns an instance of Sympa::DatabaseDriver | ||||
43 | # subclass not inheriting this class. That's why probe_db() isn't the method | ||||
44 | # but a static function. | ||||
45 | # spent 3.05ms within Sympa::DatabaseManager::instance which was called 1722 times, avg 2µs/call:
# 1377 times (2.44ms+0s) by Sympa::List::has_included_users at line 5786 of /usr/local/libexec/sympa/Sympa/List.pm, avg 2µs/call
# 345 times (608µs+0s) by Sympa::List::get_lists at line 4270 of /usr/local/libexec/sympa/Sympa/List.pm, avg 2µs/call | ||||
46 | 1722 | 522µs | my $class = shift; | ||
47 | |||||
48 | 1722 | 3.25ms | return $instance if $instance; | ||
49 | |||||
50 | my $self; | ||||
51 | my $db_conf = Conf::get_parameters_group('*', 'Database related'); | ||||
52 | |||||
53 | return undef | ||||
54 | unless $self = Sympa::Database->new($db_conf->{'db_type'}, %$db_conf) | ||||
55 | and $self->connect; | ||||
56 | |||||
57 | # At once connection succeeded, we keep trying to connect. | ||||
58 | # Unless in a web context, because we can't afford long response time on | ||||
59 | # the web interface. | ||||
60 | $self->set_persistent(1) unless $ENV{'GATEWAY_INTERFACE'}; | ||||
61 | |||||
62 | $instance = $self; | ||||
63 | return $self; | ||||
64 | } | ||||
65 | |||||
66 | sub disconnect { | ||||
67 | my $class = shift; | ||||
68 | |||||
69 | return 0 unless $instance; | ||||
70 | |||||
71 | $instance->set_persistent(0); | ||||
72 | $instance->disconnect; | ||||
73 | undef $instance; | ||||
74 | return 1; | ||||
75 | } | ||||
76 | |||||
77 | # db structure description has moved in Sympa::DatabaseDescription. | ||||
78 | my %not_null = Sympa::DatabaseDescription::not_null(); | ||||
79 | my %primary = Sympa::DatabaseDescription::primary(); | ||||
80 | my %autoincrement = Sympa::DatabaseDescription::autoincrement(); | ||||
81 | |||||
82 | # List the required INDEXES | ||||
83 | # 1st key is the concerned table | ||||
84 | # 2nd key is the index name | ||||
85 | # the table lists the field on which the index applies | ||||
86 | my %indexes = %Sympa::DatabaseDescription::indexes; | ||||
87 | |||||
88 | # table indexes that can be removed during upgrade process | ||||
89 | my @former_indexes = @Sympa::DatabaseDescription::former_indexes; | ||||
90 | |||||
91 | sub probe_db { | ||||
92 | $log->syslog('debug3', 'Checking database structure'); | ||||
93 | |||||
94 | my $sdm = __PACKAGE__->instance; | ||||
95 | unless ($sdm) { | ||||
96 | $log->syslog('err', | ||||
97 | 'Could not check the database structure. Make sure that database connection is available' | ||||
98 | ); | ||||
99 | return undef; | ||||
100 | } | ||||
101 | |||||
102 | my $db_struct = _db_struct($sdm); | ||||
103 | my $update_db_field_types = | ||||
104 | Conf::get_robot_conf('*', 'update_db_field_types') || 'off'; | ||||
105 | |||||
106 | # Does the driver support probing database structure? | ||||
107 | foreach my $method ( | ||||
108 | qw(is_autoinc get_tables get_fields get_primary_key get_indexes)) { | ||||
109 | unless ($sdm->can($method)) { | ||||
110 | $log->syslog('notice', | ||||
111 | 'Could not check the database structure: required methods have not been implemented' | ||||
112 | ); | ||||
113 | return 1; | ||||
114 | } | ||||
115 | } | ||||
116 | |||||
117 | # Does the driver support updating database structure? | ||||
118 | my $may_update; | ||||
119 | unless ($update_db_field_types eq 'auto') { | ||||
120 | $may_update = 0; | ||||
121 | } else { | ||||
122 | $may_update = 1; | ||||
123 | foreach my $method ( | ||||
124 | qw(set_autoinc add_table update_field add_field delete_field | ||||
125 | unset_primary_key set_primary_key unset_index set_index) | ||||
126 | ) { | ||||
127 | unless ($sdm->can($method)) { | ||||
128 | $may_update = 0; | ||||
129 | last; | ||||
130 | } | ||||
131 | } | ||||
132 | } | ||||
133 | |||||
134 | ## Database structure | ||||
135 | ## Report changes to listmaster | ||||
136 | my @report; | ||||
137 | |||||
138 | ## Get tables | ||||
139 | my @tables; | ||||
140 | my $list_of_tables; | ||||
141 | if ($list_of_tables = $sdm->get_tables()) { | ||||
142 | @tables = @{$list_of_tables}; | ||||
143 | } else { | ||||
144 | @tables = (); | ||||
145 | } | ||||
146 | |||||
147 | my %real_struct; | ||||
148 | # Check required tables | ||||
149 | foreach my $t1 (keys %$db_struct) { | ||||
150 | my $found; | ||||
151 | foreach my $t2 (@tables) { | ||||
152 | $found = 1 if ($t1 eq $t2); | ||||
153 | } | ||||
154 | unless ($found) { | ||||
155 | my $rep; | ||||
156 | if ( $may_update | ||||
157 | and $rep = $sdm->add_table({'table' => $t1})) { | ||||
158 | push @report, $rep; | ||||
159 | $log->syslog( | ||||
160 | 'notice', 'Table %s created in database %s', | ||||
161 | $t1, Conf::get_robot_conf('*', 'db_name') | ||||
162 | ); | ||||
163 | push @tables, $t1; | ||||
164 | $real_struct{$t1} = {}; | ||||
165 | } | ||||
166 | } | ||||
167 | } | ||||
168 | ## Get fields | ||||
169 | foreach my $t (keys %$db_struct) { | ||||
170 | $real_struct{$t} = $sdm->get_fields({'table' => $t}); | ||||
171 | } | ||||
172 | ## Check tables structure if we could get it | ||||
173 | ## Only performed with mysql , Pg and SQLite | ||||
174 | if (%real_struct) { | ||||
175 | foreach my $t (keys %$db_struct) { | ||||
176 | unless ($real_struct{$t}) { | ||||
177 | $log->syslog( | ||||
178 | 'err', | ||||
179 | 'Table "%s" not found in database "%s"; you should create it with create_db.%s script', | ||||
180 | $t, | ||||
181 | Conf::get_robot_conf('*', 'db_name'), | ||||
182 | Conf::get_robot_conf('*', 'db_type') | ||||
183 | ); | ||||
184 | return undef; | ||||
185 | } | ||||
186 | unless ( | ||||
187 | _check_fields( | ||||
188 | $sdm, | ||||
189 | { 'table' => $t, | ||||
190 | 'report' => \@report, | ||||
191 | 'real_struct' => \%real_struct, | ||||
192 | 'may_update' => $may_update, | ||||
193 | } | ||||
194 | ) | ||||
195 | ) { | ||||
196 | $log->syslog( | ||||
197 | 'err', | ||||
198 | 'Unable to check the validity of fields definition for table %s. Aborting', | ||||
199 | $t | ||||
200 | ); | ||||
201 | return undef; | ||||
202 | } | ||||
203 | ## Remove temporary DB field | ||||
204 | if ($may_update and $real_struct{$t}{'temporary'}) { | ||||
205 | $sdm->delete_field( | ||||
206 | { 'table' => $t, | ||||
207 | 'field' => 'temporary', | ||||
208 | } | ||||
209 | ); | ||||
210 | delete $real_struct{$t}{'temporary'}; | ||||
211 | } | ||||
212 | |||||
213 | ## Check that primary key has the right structure. | ||||
214 | unless ( | ||||
215 | _check_primary_key( | ||||
216 | $sdm, | ||||
217 | { 'table' => $t, | ||||
218 | 'report' => \@report, | ||||
219 | 'may_update' => $may_update | ||||
220 | } | ||||
221 | ) | ||||
222 | ) { | ||||
223 | $log->syslog( | ||||
224 | 'err', | ||||
225 | 'Unable to check the validity of primary key for table %s. Aborting', | ||||
226 | $t | ||||
227 | ); | ||||
228 | return undef; | ||||
229 | } | ||||
230 | |||||
231 | unless ( | ||||
232 | _check_indexes( | ||||
233 | $sdm, | ||||
234 | { 'table' => $t, | ||||
235 | 'report' => \@report, | ||||
236 | 'may_update' => $may_update | ||||
237 | } | ||||
238 | ) | ||||
239 | ) { | ||||
240 | $log->syslog( | ||||
241 | 'err', | ||||
242 | 'Unable to check the valifity of indexes for table %s. Aborting', | ||||
243 | $t | ||||
244 | ); | ||||
245 | return undef; | ||||
246 | } | ||||
247 | } | ||||
248 | # add autoincrement if needed | ||||
249 | foreach my $table (keys %autoincrement) { | ||||
250 | unless ( | ||||
251 | $sdm->is_autoinc( | ||||
252 | {'table' => $table, 'field' => $autoincrement{$table}} | ||||
253 | ) | ||||
254 | ) { | ||||
255 | if ($may_update | ||||
256 | and $sdm->set_autoinc( | ||||
257 | { 'table' => $table, | ||||
258 | 'field' => $autoincrement{$table}, | ||||
259 | 'field_type' => $db_struct->{$table} | ||||
260 | ->{$autoincrement{$table}}, | ||||
261 | } | ||||
262 | ) | ||||
263 | ) { | ||||
264 | $log->syslog('notice', | ||||
265 | "Setting table $table field $autoincrement{$table} as autoincrement" | ||||
266 | ); | ||||
267 | } else { | ||||
268 | $log->syslog('err', | ||||
269 | "Could not set table $table field $autoincrement{$table} as autoincrement" | ||||
270 | ); | ||||
271 | return undef; | ||||
272 | } | ||||
273 | } | ||||
274 | } | ||||
275 | } else { | ||||
276 | $log->syslog('err', | ||||
277 | "Could not check the database structure. consider verify it manually before launching Sympa." | ||||
278 | ); | ||||
279 | return undef; | ||||
280 | } | ||||
281 | |||||
282 | ## Notify listmaster | ||||
283 | Sympa::send_notify_to_listmaster('*', 'db_struct_updated', | ||||
284 | {'report' => \@report}) | ||||
285 | if @report; | ||||
286 | |||||
287 | return 1; | ||||
288 | } | ||||
289 | |||||
290 | # Returns a hashref definition by all types of RDBMS Sympa supports. | ||||
291 | # Keys are table names and values are hashrefs with keys as field names and | ||||
292 | # values are their field types converted according to database driver. | ||||
293 | sub _db_struct { | ||||
294 | my $sdm = shift; | ||||
295 | |||||
296 | my $db_struct; | ||||
297 | my %full_db_struct = Sympa::DatabaseDescription::full_db_struct(); | ||||
298 | |||||
299 | foreach my $table (keys %full_db_struct) { | ||||
300 | foreach my $field (keys %{$full_db_struct{$table}{'fields'}}) { | ||||
301 | my $trans = | ||||
302 | $sdm->translate_type( | ||||
303 | $full_db_struct{$table}{'fields'}{$field}{'struct'}); | ||||
304 | |||||
305 | $db_struct->{$table} ||= {}; | ||||
306 | $db_struct->{$table}->{$field} = $trans; | ||||
307 | } | ||||
308 | } | ||||
309 | return $db_struct; | ||||
310 | } | ||||
311 | |||||
312 | sub _check_fields { | ||||
313 | my $sdm = shift; | ||||
314 | my $param = shift; | ||||
315 | my $t = $param->{'table'}; | ||||
316 | my %real_struct = %{$param->{'real_struct'}}; | ||||
317 | my $report_ref = $param->{'report'}; | ||||
318 | my $may_update = $param->{'may_update'}; | ||||
319 | |||||
320 | my $db_struct = _db_struct($sdm); | ||||
321 | |||||
322 | foreach my $f (sort keys %{$db_struct->{$t}}) { | ||||
323 | unless ($real_struct{$t}{$f}) { | ||||
324 | push @{$report_ref}, | ||||
325 | sprintf( | ||||
326 | "Field '%s' (table '%s' ; database '%s') was NOT found. Attempting to add it...", | ||||
327 | $f, $t, Conf::get_robot_conf('*', 'db_name')); | ||||
328 | $log->syslog( | ||||
329 | 'notice', | ||||
330 | 'Field "%s" (table "%s"; database "%s") was NOT found. Attempting to add it...', | ||||
331 | $f, | ||||
332 | $t, | ||||
333 | Conf::get_robot_conf('*', 'db_name') | ||||
334 | ); | ||||
335 | |||||
336 | my $rep; | ||||
337 | if ($may_update | ||||
338 | and $rep = $sdm->add_field( | ||||
339 | { 'table' => $t, | ||||
340 | 'field' => $f, | ||||
341 | 'type' => $db_struct->{$t}->{$f}, | ||||
342 | 'notnull' => $not_null{$f}, | ||||
343 | 'autoinc' => | ||||
344 | ($autoincrement{$t} and $autoincrement{$t} eq $f), | ||||
345 | 'primary' => ( | ||||
346 | scalar @{$primary{$t} || []} == 1 | ||||
347 | and $primary{$t}->[0] eq $f | ||||
348 | ), | ||||
349 | } | ||||
350 | ) | ||||
351 | ) { | ||||
352 | push @{$report_ref}, $rep; | ||||
353 | } else { | ||||
354 | $log->syslog('err', | ||||
355 | 'Addition of fields in database failed. Aborting'); | ||||
356 | return undef; | ||||
357 | } | ||||
358 | next; | ||||
359 | } | ||||
360 | |||||
361 | ## Change DB types if different and if update_db_types enabled | ||||
362 | if ($may_update) { | ||||
363 | unless ( | ||||
364 | _check_db_field_type( | ||||
365 | effective_format => $real_struct{$t}{$f}, | ||||
366 | required_format => $db_struct->{$t}->{$f} | ||||
367 | ) | ||||
368 | ) { | ||||
369 | push @{$report_ref}, | ||||
370 | sprintf( | ||||
371 | "Field '%s' (table '%s' ; database '%s') does NOT have awaited type (%s). Attempting to change it...", | ||||
372 | $f, $t, | ||||
373 | Conf::get_robot_conf('*', 'db_name'), | ||||
374 | $db_struct->{$t}->{$f} | ||||
375 | ); | ||||
376 | |||||
377 | $log->syslog( | ||||
378 | 'notice', | ||||
379 | 'Field "%s" (table "%s"; database "%s") does NOT have awaited type (%s) where type in database seems to be (%s). Attempting to change it...', | ||||
380 | $f, | ||||
381 | $t, | ||||
382 | Conf::get_robot_conf('*', 'db_name'), | ||||
383 | $db_struct->{$t}->{$f}, | ||||
384 | $real_struct{$t}{$f} | ||||
385 | ); | ||||
386 | |||||
387 | my $rep; | ||||
388 | if ($may_update | ||||
389 | and $rep = $sdm->update_field( | ||||
390 | { 'table' => $t, | ||||
391 | 'field' => $f, | ||||
392 | 'type' => $db_struct->{$t}->{$f}, | ||||
393 | 'notnull' => $not_null{$f}, | ||||
394 | } | ||||
395 | ) | ||||
396 | ) { | ||||
397 | push @{$report_ref}, $rep; | ||||
398 | } else { | ||||
399 | $log->syslog('err', | ||||
400 | 'Fields update in database failed. Aborting'); | ||||
401 | return undef; | ||||
402 | } | ||||
403 | } | ||||
404 | } else { | ||||
405 | unless ($real_struct{$t}{$f} eq $db_struct->{$t}->{$f}) { | ||||
406 | $log->syslog( | ||||
407 | 'err', | ||||
408 | 'Field "%s" (table "%s"; database "%s") does NOT have awaited type (%s)', | ||||
409 | $f, | ||||
410 | $t, | ||||
411 | Conf::get_robot_conf('*', 'db_name'), | ||||
412 | $db_struct->{$t}->{$f} | ||||
413 | ); | ||||
414 | $log->syslog('err', | ||||
415 | 'Sympa\'s database structure may have change since last update ; please check RELEASE_NOTES' | ||||
416 | ); | ||||
417 | return undef; | ||||
418 | } | ||||
419 | } | ||||
420 | } | ||||
421 | return 1; | ||||
422 | } | ||||
423 | |||||
424 | sub _check_primary_key { | ||||
425 | my $sdm = shift; | ||||
426 | my $param = shift; | ||||
427 | my $t = $param->{'table'}; | ||||
428 | my $report_ref = $param->{'report'}; | ||||
429 | my $may_update = $param->{'may_update'}; | ||||
430 | |||||
431 | my $list_of_keys = join ',', @{$primary{$t}}; | ||||
432 | my $key_as_string = "$t [$list_of_keys]"; | ||||
433 | $log->syslog('debug', | ||||
434 | 'Checking primary keys for table %s expected_keys %s', | ||||
435 | $t, $key_as_string); | ||||
436 | |||||
437 | my $should_update = _check_key( | ||||
438 | $sdm, | ||||
439 | { 'table' => $t, | ||||
440 | 'key_name' => 'primary', | ||||
441 | 'expected_keys' => $primary{$t} | ||||
442 | } | ||||
443 | ); | ||||
444 | if ($should_update) { | ||||
445 | my $list_of_keys = join ',', @{$primary{$t}}; | ||||
446 | my $key_as_string = "$t [$list_of_keys]"; | ||||
447 | |||||
448 | # Fixup: At 6.2a.29 r7637, family_exclusion field became a part of | ||||
449 | # primary key. But it could contain NULL and may break not_null | ||||
450 | # constraint. | ||||
451 | if (grep { $_ eq 'family_exclusion' } @{$primary{$t}}) { | ||||
452 | $sdm->do_query( | ||||
453 | q{UPDATE exclusion_table | ||||
454 | SET family_exclusion = '' | ||||
455 | WHERE family_exclusion IS NULL} | ||||
456 | ); | ||||
457 | } | ||||
458 | |||||
459 | if ($should_update->{'empty'}) { | ||||
460 | if (@{$primary{$t}}) { | ||||
461 | $log->syslog('notice', 'Primary key %s is missing. Adding it', | ||||
462 | $key_as_string); | ||||
463 | ## Add primary key | ||||
464 | my $rep = undef; | ||||
465 | if ($may_update | ||||
466 | and $rep = $sdm->set_primary_key( | ||||
467 | {'table' => $t, 'fields' => $primary{$t}} | ||||
468 | ) | ||||
469 | ) { | ||||
470 | push @{$report_ref}, $rep; | ||||
471 | } else { | ||||
472 | return undef; | ||||
473 | } | ||||
474 | } | ||||
475 | } elsif ($should_update->{'existing_key_correct'}) { | ||||
476 | $log->syslog('debug', | ||||
477 | "Existing key correct (%s) nothing to change", | ||||
478 | $key_as_string); | ||||
479 | } else { | ||||
480 | ## drop previous primary key | ||||
481 | my $rep = undef; | ||||
482 | if ( $may_update | ||||
483 | and $rep = $sdm->unset_primary_key({'table' => $t})) { | ||||
484 | push @{$report_ref}, $rep; | ||||
485 | } else { | ||||
486 | return undef; | ||||
487 | } | ||||
488 | ## Add primary key | ||||
489 | if (@{$primary{$t}}) { | ||||
490 | $rep = undef; | ||||
491 | if ($may_update | ||||
492 | and $rep = $sdm->set_primary_key( | ||||
493 | {'table' => $t, 'fields' => $primary{$t}} | ||||
494 | ) | ||||
495 | ) { | ||||
496 | push @{$report_ref}, $rep; | ||||
497 | } else { | ||||
498 | return undef; | ||||
499 | } | ||||
500 | } | ||||
501 | } | ||||
502 | } else { | ||||
503 | $log->syslog('err', 'Unable to evaluate table %s primary key', $t); | ||||
504 | return undef; | ||||
505 | } | ||||
506 | return 1; | ||||
507 | } | ||||
508 | |||||
509 | sub _check_indexes { | ||||
510 | my $sdm = shift; | ||||
511 | my $param = shift; | ||||
512 | my $t = $param->{'table'}; | ||||
513 | my $report_ref = $param->{'report'}; | ||||
514 | my $may_update = $param->{'may_update'}; | ||||
515 | $log->syslog('debug', 'Checking indexes for table %s', $t); | ||||
516 | |||||
517 | ## drop previous index if this index is not a primary key and was defined | ||||
518 | ## by a previous Sympa version | ||||
519 | my %index_columns = %{$sdm->get_indexes({'table' => $t})}; | ||||
520 | foreach my $idx (keys %index_columns) { | ||||
521 | $log->syslog('debug', 'Found index %s', $idx); | ||||
522 | ## Remove the index if obsolete. | ||||
523 | foreach my $known_index (@former_indexes) { | ||||
524 | if ($idx eq $known_index) { | ||||
525 | my $rep; | ||||
526 | $log->syslog('notice', 'Removing obsolete index %s', $idx); | ||||
527 | if ( $may_update | ||||
528 | and $rep = | ||||
529 | $sdm->unset_index({'table' => $t, 'index' => $idx})) { | ||||
530 | push @{$report_ref}, $rep; | ||||
531 | } | ||||
532 | last; | ||||
533 | } | ||||
534 | } | ||||
535 | } | ||||
536 | |||||
537 | ## Create required indexes | ||||
538 | foreach my $idx (keys %{$indexes{$t}}) { | ||||
539 | ## Add indexes | ||||
540 | unless ($index_columns{$idx}) { | ||||
541 | my $rep; | ||||
542 | $log->syslog('notice', | ||||
543 | 'Index %s on table %s does not exist. Adding it', | ||||
544 | $idx, $t); | ||||
545 | if ($may_update | ||||
546 | and $rep = $sdm->set_index( | ||||
547 | { 'table' => $t, | ||||
548 | 'index_name' => $idx, | ||||
549 | 'fields' => $indexes{$t}{$idx} | ||||
550 | } | ||||
551 | ) | ||||
552 | ) { | ||||
553 | push @{$report_ref}, $rep; | ||||
554 | } | ||||
555 | } | ||||
556 | my $index_check = _check_key( | ||||
557 | $sdm, | ||||
558 | { 'table' => $t, | ||||
559 | 'key_name' => $idx, | ||||
560 | 'expected_keys' => $indexes{$t}{$idx} | ||||
561 | } | ||||
562 | ); | ||||
563 | if ($index_check) { | ||||
564 | my $list_of_fields = join ',', @{$indexes{$t}{$idx}}; | ||||
565 | my $index_as_string = "$idx: $t [$list_of_fields]"; | ||||
566 | if ($index_check->{'empty'}) { | ||||
567 | ## Add index | ||||
568 | my $rep = undef; | ||||
569 | $log->syslog('notice', 'Index %s is missing. Adding it', | ||||
570 | $index_as_string); | ||||
571 | if ($may_update | ||||
572 | and $rep = $sdm->set_index( | ||||
573 | { 'table' => $t, | ||||
574 | 'index_name' => $idx, | ||||
575 | 'fields' => $indexes{$t}{$idx} | ||||
576 | } | ||||
577 | ) | ||||
578 | ) { | ||||
579 | push @{$report_ref}, $rep; | ||||
580 | } else { | ||||
581 | return undef; | ||||
582 | } | ||||
583 | } elsif ($index_check->{'existing_key_correct'}) { | ||||
584 | $log->syslog('debug', | ||||
585 | "Existing index correct (%s) nothing to change", | ||||
586 | $index_as_string); | ||||
587 | } else { | ||||
588 | ## drop previous index | ||||
589 | $log->syslog('notice', | ||||
590 | 'Index %s has not the right structure. Changing it', | ||||
591 | $index_as_string); | ||||
592 | my $rep = undef; | ||||
593 | if ( $may_update | ||||
594 | and $rep = | ||||
595 | $sdm->unset_index({'table' => $t, 'index' => $idx})) { | ||||
596 | push @{$report_ref}, $rep; | ||||
597 | } | ||||
598 | ## Add index | ||||
599 | $rep = undef; | ||||
600 | if ($may_update | ||||
601 | and $rep = $sdm->set_index( | ||||
602 | { 'table' => $t, | ||||
603 | 'index_name' => $idx, | ||||
604 | 'fields' => $indexes{$t}{$idx} | ||||
605 | } | ||||
606 | ) | ||||
607 | ) { | ||||
608 | push @{$report_ref}, $rep; | ||||
609 | } else { | ||||
610 | return undef; | ||||
611 | } | ||||
612 | } | ||||
613 | } else { | ||||
614 | $log->syslog('err', 'Unable to evaluate index %s in table %s', | ||||
615 | $idx, $t); | ||||
616 | return undef; | ||||
617 | } | ||||
618 | } | ||||
619 | return 1; | ||||
620 | } | ||||
621 | |||||
622 | # Checks the compliance of a key of a table compared to what it is supposed to | ||||
623 | # reference. | ||||
624 | # | ||||
625 | # IN: A ref to hash containing the following keys: | ||||
626 | # * 'table' : the name of the table for which we want to check the primary key | ||||
627 | # * 'key_name' : the kind of key tested: | ||||
628 | # - if the value is 'primary', the key tested will be the table primary key | ||||
629 | # - for any other value, the index whose name is this value will be tested. | ||||
630 | # * 'expected_keys' : A ref to an array containing the list of fields that we | ||||
631 | # expect to be part of the key. | ||||
632 | # | ||||
633 | # OUT: - Returns a ref likely to contain the following values: | ||||
634 | # * 'empty': if this key is defined, then no key was found for the table | ||||
635 | # * 'existing_key_correct': if this key's value is 1, then a key | ||||
636 | # exists and is fair to the structure defined in the 'expected_keys' | ||||
637 | # parameter hash. | ||||
638 | # Otherwise, the key is not correct. | ||||
639 | # * 'missing_key': if this key is defined, then a part of the key was missing. | ||||
640 | # The value associated to this key is a hash whose keys are the names | ||||
641 | # of the fields missing in the key. | ||||
642 | # * 'unexpected_key': if this key is defined, then we found fields in the | ||||
643 | # actual key that don't belong to the list provided in the 'expected_keys' | ||||
644 | # parameter hash. | ||||
645 | # The value associated to this key is a hash whose keys are the names of the | ||||
646 | # fields unexpectedely found. | ||||
647 | sub _check_key { | ||||
648 | my $sdm = shift; | ||||
649 | my $param = shift; | ||||
650 | $log->syslog('debug', 'Checking %s key structure for table %s', | ||||
651 | $param->{'key_name'}, $param->{'table'}); | ||||
652 | my $keysFound; | ||||
653 | my $result; | ||||
654 | if (lc($param->{'key_name'}) eq 'primary') { | ||||
655 | return undef | ||||
656 | unless ($keysFound = | ||||
657 | $sdm->get_primary_key({'table' => $param->{'table'}})); | ||||
658 | } else { | ||||
659 | return undef | ||||
660 | unless ($keysFound = | ||||
661 | $sdm->get_indexes({'table' => $param->{'table'}})); | ||||
662 | $keysFound = $keysFound->{$param->{'key_name'}}; | ||||
663 | } | ||||
664 | |||||
665 | my @keys_list = keys %{$keysFound}; | ||||
666 | if ($#keys_list < 0) { | ||||
667 | $result->{'empty'} = 1; | ||||
668 | } else { | ||||
669 | $result->{'existing_key_correct'} = 1; | ||||
670 | my %expected_keys; | ||||
671 | foreach my $expected_field (@{$param->{'expected_keys'}}) { | ||||
672 | $expected_keys{$expected_field} = 1; | ||||
673 | } | ||||
674 | foreach my $field (@{$param->{'expected_keys'}}) { | ||||
675 | unless ($keysFound->{$field}) { | ||||
676 | $log->syslog('info', | ||||
677 | 'Table %s: Missing expected key part %s in %s key', | ||||
678 | $param->{'table'}, $field, $param->{'key_name'}); | ||||
679 | $result->{'missing_key'}{$field} = 1; | ||||
680 | $result->{'existing_key_correct'} = 0; | ||||
681 | } | ||||
682 | } | ||||
683 | foreach my $field (keys %{$keysFound}) { | ||||
684 | unless ($expected_keys{$field}) { | ||||
685 | $log->syslog('info', | ||||
686 | 'Table %s: Found unexpected key part %s in %s key', | ||||
687 | $param->{'table'}, $field, $param->{'key_name'}); | ||||
688 | $result->{'unexpected_key'}{$field} = 1; | ||||
689 | $result->{'existing_key_correct'} = 0; | ||||
690 | } | ||||
691 | } | ||||
692 | } | ||||
693 | return $result; | ||||
694 | } | ||||
695 | |||||
696 | ## Compare required DB field type | ||||
697 | ## Input : required_format, effective_format | ||||
698 | ## Output : return 1 if field type is appropriate AND size >= required size | ||||
699 | sub _check_db_field_type { | ||||
700 | my %param = @_; | ||||
701 | |||||
702 | my ($required_type, $required_size, $effective_type, $effective_size); | ||||
703 | |||||
704 | if ($param{'required_format'} =~ /^(\w+)(\((\d+)\))?$/) { | ||||
705 | ($required_type, $required_size) = ($1, $3); | ||||
706 | } | ||||
707 | |||||
708 | if ($param{'effective_format'} =~ /^(\w+)(\((\d+)\))?$/) { | ||||
709 | ($effective_type, $effective_size) = ($1, $3); | ||||
710 | } | ||||
711 | |||||
712 | if (Sympa::Tools::Data::smart_eq($effective_type, $required_type) | ||||
713 | and (not defined $required_size or $effective_size >= $required_size)) | ||||
714 | { | ||||
715 | return 1; | ||||
716 | } | ||||
717 | |||||
718 | return 0; | ||||
719 | } | ||||
720 | |||||
721 | 1; | ||||
722 | __END__ |