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, 2020 The Sympa Community. See the AUTHORS.md 12# file at the 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::MySQL; 29 30use strict; 31use warnings; 32 33use Sympa::Log; 34 35use base qw(Sympa::DatabaseDriver); 36 37my $log = Sympa::Log->instance; 38 39use constant required_modules => [qw(DBD::mysql)]; 40 41sub build_connect_string { 42 my $self = shift; 43 44 my $connect_string = 45 'DBI:mysql:' 46 . $self->{'db_name'} . ':' 47 . ($self->{'db_host'} || 'localhost'); 48 $connect_string .= ';port=' . $self->{'db_port'} 49 if defined $self->{'db_port'}; 50 $connect_string .= ';' . $self->{'db_options'} 51 if defined $self->{'db_options'}; 52 return $connect_string; 53} 54 55sub connect { 56 my $self = shift; 57 58 $self->SUPER::connect() or return undef; 59 60 # - At first, reset "mysql_auto_reconnect" driver attribute. 61 # DBI::connect() sets it to true not according to \%attr argument 62 # when the processes are running under mod_perl or CGI environment 63 # so that "SET NAMES utf8" will be skipped. 64 # - Set client-side character set to "utf8" or "utf8mb4". 65 # - Reset SQL mode that is given various default by versions of MySQL. 66 $self->__dbh->{'mysql_auto_reconnect'} = 0; 67 unless (defined $self->__dbh->do("SET NAMES 'utf8mb4'") 68 or defined $self->__dbh->do("SET NAMES 'utf8'")) { 69 $log->syslog('err', 'Cannot set client-side character set: %s', 70 $self->error); 71 } 72 unless (defined $self->__dbh->do("SET SESSION sql_mode=''")) { 73 $log->syslog('err', 'Cannot reset SQL mode: %s', $self->error); 74 return undef; 75 } 76 77 return 1; 78} 79 80sub get_substring_clause { 81 my $self = shift; 82 my $param = shift; 83 $log->syslog('debug', 'Building substring caluse'); 84 return 85 "REVERSE(SUBSTRING(" 86 . $param->{'source_field'} 87 . " FROM position('" 88 . $param->{'separator'} . "' IN " 89 . $param->{'source_field'} 90 . ") FOR " 91 . $param->{'substring_length'} . "))"; 92} 93 94# DEPRECATED. 95#sub get_limit_clause ( { rows_count => $rows, offset => $offset } ); 96 97# DEPRECATED. 98#sub get_formatted_date; 99 100sub is_autoinc { 101 my $self = shift; 102 my $param = shift; 103 $log->syslog('debug', 'Checking whether field %s.%s is autoincremental', 104 $param->{'field'}, $param->{'table'}); 105 my $sth; 106 unless ( 107 $sth = $self->do_query( 108 "SHOW FIELDS FROM `%s` WHERE Extra ='auto_increment' and Field = '%s'", 109 $param->{'table'}, 110 $param->{'field'} 111 ) 112 ) { 113 $log->syslog('err', 114 'Unable to gather autoincrement field named %s for table %s', 115 $param->{'field'}, $param->{'table'}); 116 return undef; 117 } 118 my $ref = $sth->fetchrow_hashref('NAME_lc'); 119 return ($ref->{'field'} eq $param->{'field'}); 120} 121 122sub set_autoinc { 123 my $self = shift; 124 my $param = shift; 125 my $field_type = 126 defined($param->{'field_type'}) 127 ? $param->{'field_type'} 128 : 'BIGINT( 20 )'; 129 $log->syslog('debug', 'Setting field %s.%s as autoincremental', 130 $param->{'field'}, $param->{'table'}); 131 unless ( 132 $self->do_query( 133 "ALTER TABLE `%s` CHANGE `%s` `%s` %s NOT NULL AUTO_INCREMENT", 134 $param->{'table'}, $param->{'field'}, 135 $param->{'field'}, $field_type 136 ) 137 ) { 138 $log->syslog('err', 139 'Unable to set field %s in table %s as autoincrement', 140 $param->{'field'}, $param->{'table'}); 141 return undef; 142 } 143 return 1; 144} 145 146sub get_tables { 147 my $self = shift; 148 $log->syslog('debug', 'Retrieving all tables in database %s', 149 $self->{'db_name'}); 150 my @raw_tables; 151 my @result; 152 unless (@raw_tables = $self->__dbh->tables()) { 153 $log->syslog('err', 154 'Unable to retrieve the list of tables from database %s', 155 $self->{'db_name'}); 156 return undef; 157 } 158 159 foreach my $t (@raw_tables) { 160 # Clean table names that would look like `databaseName`.`tableName` 161 # (mysql) 162 $t =~ s/^\`[^\`]+\`\.//; 163 # Clean table names that could be surrounded by `` (recent DBD::mysql 164 # release) 165 $t =~ s/^\`(.+)\`$/$1/; 166 push @result, $t; 167 } 168 return \@result; 169} 170 171sub add_table { 172 my $self = shift; 173 my $param = shift; 174 $log->syslog('debug', 'Adding table %s to database %s', 175 $param->{'table'}, $self->{'db_name'}); 176 unless ( 177 $self->do_query( 178 "CREATE TABLE %s (temporary INT) DEFAULT CHARACTER SET utf8", 179 $param->{'table'} 180 ) 181 ) { 182 $log->syslog('err', 'Could not create table %s in database %s', 183 $param->{'table'}, $self->{'db_name'}); 184 return undef; 185 } 186 return sprintf "Table %s created in database %s", $param->{'table'}, 187 $self->{'db_name'}; 188} 189 190sub get_fields { 191 my $self = shift; 192 my $param = shift; 193 $log->syslog('debug', 'Getting fields list from table %s in database %s', 194 $param->{'table'}, $self->{'db_name'}); 195 my $sth; 196 my %result; 197 unless ($sth = $self->do_query("SHOW FIELDS FROM %s", $param->{'table'})) 198 { 199 $log->syslog('err', 200 'Could not get the list of fields from table %s in database %s', 201 $param->{'table'}, $self->{'db_name'}); 202 return undef; 203 } 204 while (my $ref = $sth->fetchrow_hashref('NAME_lc')) { 205 $result{$ref->{'field'}} = $ref->{'type'}; 206 } 207 return \%result; 208} 209 210sub update_field { 211 my $self = shift; 212 my $param = shift; 213 $log->syslog('debug', 'Updating field %s in table %s (%s, %s)', 214 $param->{'field'}, $param->{'table'}, $param->{'type'}, 215 $param->{'notnull'}); 216 my $options = ''; 217 if ($param->{'notnull'}) { 218 $options .= ' NOT NULL '; 219 } 220 my $report = sprintf( 221 "ALTER TABLE %s CHANGE %s %s %s %s", 222 $param->{'table'}, $param->{'field'}, $param->{'field'}, 223 $param->{'type'}, $options 224 ); 225 $log->syslog('notice', "ALTER TABLE %s CHANGE %s %s %s %s", 226 $param->{'table'}, $param->{'field'}, $param->{'field'}, 227 $param->{'type'}, $options); 228 unless ( 229 $self->do_query( 230 "ALTER TABLE %s CHANGE %s %s %s %s", 231 $param->{'table'}, $param->{'field'}, $param->{'field'}, 232 $param->{'type'}, $options 233 ) 234 ) { 235 $log->syslog('err', 'Could not change field "%s" in table "%s"', 236 $param->{'field'}, $param->{'table'}); 237 return undef; 238 } 239 $report .= sprintf("\nField %s in table %s, structure updated", 240 $param->{'field'}, $param->{'table'}); 241 $log->syslog('info', 'Field %s in table %s, structure updated', 242 $param->{'field'}, $param->{'table'}); 243 return $report; 244} 245 246sub add_field { 247 my $self = shift; 248 my $param = shift; 249 $log->syslog( 250 'debug', 'Adding field %s in table %s (%s, %s, %s, %s)', 251 $param->{'field'}, $param->{'table'}, 252 $param->{'type'}, $param->{'notnull'}, 253 $param->{'autoinc'}, $param->{'primary'} 254 ); 255 my $options = ''; 256 # To prevent "Cannot add a NOT NULL column with default value NULL" errors 257 if ($param->{'notnull'}) { 258 $options .= 'NOT NULL '; 259 } 260 if ($param->{'autoinc'}) { 261 $options .= ' AUTO_INCREMENT '; 262 } 263 if ($param->{'primary'}) { 264 $options .= ' PRIMARY KEY '; 265 } 266 unless ( 267 $self->do_query( 268 "ALTER TABLE %s ADD %s %s %s", $param->{'table'}, 269 $param->{'field'}, $param->{'type'}, 270 $options 271 ) 272 ) { 273 $log->syslog('err', 274 'Could not add field %s to table %s in database %s', 275 $param->{'field'}, $param->{'table'}, $self->{'db_name'}); 276 return undef; 277 } 278 279 my $report = sprintf('Field %s added to table %s (options : %s)', 280 $param->{'field'}, $param->{'table'}, $options); 281 $log->syslog('info', 'Field %s added to table %s (options: %s)', 282 $param->{'field'}, $param->{'table'}, $options); 283 284 return $report; 285} 286 287sub delete_field { 288 my $self = shift; 289 my $param = shift; 290 $log->syslog('debug', 'Deleting field %s from table %s', 291 $param->{'field'}, $param->{'table'}); 292 293 unless ( 294 $self->do_query( 295 "ALTER TABLE %s DROP COLUMN `%s`", $param->{'table'}, 296 $param->{'field'} 297 ) 298 ) { 299 $log->syslog('err', 300 'Could not delete field %s from table %s in database %s', 301 $param->{'field'}, $param->{'table'}, $self->{'db_name'}); 302 return undef; 303 } 304 305 my $report = sprintf('Field %s removed from table %s', 306 $param->{'field'}, $param->{'table'}); 307 $log->syslog('info', 'Field %s removed from table %s', 308 $param->{'field'}, $param->{'table'}); 309 310 return $report; 311} 312 313sub get_primary_key { 314 my $self = shift; 315 my $param = shift; 316 $log->syslog('debug', 'Getting primary key for table %s', 317 $param->{'table'}); 318 319 my %found_keys; 320 my $sth; 321 unless ($sth = $self->do_query("SHOW COLUMNS FROM %s", $param->{'table'})) 322 { 323 $log->syslog('err', 324 'Could not get field list from table %s in database %s', 325 $param->{'table'}, $self->{'db_name'}); 326 return undef; 327 } 328 329 my $test_request_result = $sth->fetchall_hashref('field'); 330 foreach my $scannedResult (keys %$test_request_result) { 331 if ($test_request_result->{$scannedResult}{'key'} eq "PRI") { 332 $found_keys{$scannedResult} = 1; 333 } 334 } 335 return \%found_keys; 336} 337 338sub unset_primary_key { 339 my $self = shift; 340 my $param = shift; 341 $log->syslog('debug', 'Removing primary key from table %s', 342 $param->{'table'}); 343 344 my $sth; 345 unless ($sth = 346 $self->do_query("ALTER TABLE %s DROP PRIMARY KEY", $param->{'table'})) 347 { 348 $log->syslog('err', 349 'Could not drop primary key from table %s in database %s', 350 $param->{'table'}, $self->{'db_name'}); 351 return undef; 352 } 353 my $report = "Table $param->{'table'}, PRIMARY KEY dropped"; 354 $log->syslog('info', 'Table %s, PRIMARY KEY dropped', $param->{'table'}); 355 356 return $report; 357} 358 359sub set_primary_key { 360 my $self = shift; 361 my $param = shift; 362 363 my $sth; 364 my $fields = join ',', @{$param->{'fields'}}; 365 $log->syslog('debug', 'Setting primary key for table %s (%s)', 366 $param->{'table'}, $fields); 367 unless ( 368 $sth = $self->do_query( 369 "ALTER TABLE %s ADD PRIMARY KEY (%s)", $param->{'table'}, 370 $fields 371 ) 372 ) { 373 $log->syslog( 374 'err', 375 'Could not set fields %s as primary key for table %s in database %s', 376 $fields, 377 $param->{'table'}, 378 $self->{'db_name'} 379 ); 380 return undef; 381 } 382 my $report = "Table $param->{'table'}, PRIMARY KEY set on $fields"; 383 $log->syslog('info', 'Table %s, PRIMARY KEY set on %s', 384 $param->{'table'}, $fields); 385 return $report; 386} 387 388sub get_indexes { 389 my $self = shift; 390 my $param = shift; 391 $log->syslog('debug', 'Looking for indexes in %s', $param->{'table'}); 392 393 my %found_indexes; 394 my $sth; 395 unless ($sth = $self->do_query("SHOW INDEX FROM %s", $param->{'table'})) { 396 $log->syslog( 397 'err', 398 'Could not get the list of indexes from table %s in database %s', 399 $param->{'table'}, 400 $self->{'db_name'} 401 ); 402 return undef; 403 } 404 my $index_part; 405 while ($index_part = $sth->fetchrow_hashref('NAME_lc')) { 406 if ($index_part->{'key_name'} ne "PRIMARY") { 407 my $index_name = $index_part->{'key_name'}; 408 my $field_name = $index_part->{'column_name'}; 409 $found_indexes{$index_name}{$field_name} = 1; 410 } 411 } 412 return \%found_indexes; 413} 414 415sub unset_index { 416 my $self = shift; 417 my $param = shift; 418 $log->syslog('debug', 'Removing index %s from table %s', 419 $param->{'index'}, $param->{'table'}); 420 421 my $sth; 422 unless ( 423 $sth = $self->do_query( 424 "ALTER TABLE %s DROP INDEX %s", $param->{'table'}, 425 $param->{'index'} 426 ) 427 ) { 428 $log->syslog('err', 429 'Could not drop index %s from table %s in database %s', 430 $param->{'index'}, $param->{'table'}, $self->{'db_name'}); 431 return undef; 432 } 433 my $report = "Table $param->{'table'}, index $param->{'index'} dropped"; 434 $log->syslog('info', 'Table %s, index %s dropped', 435 $param->{'table'}, $param->{'index'}); 436 437 return $report; 438} 439 440sub set_index { 441 my $self = shift; 442 my $param = shift; 443 444 my $sth; 445 my $fields = join ',', @{$param->{'fields'}}; 446 $log->syslog( 447 'debug', 448 'Setting index %s for table %s using fields %s', 449 $param->{'index_name'}, 450 $param->{'table'}, $fields 451 ); 452 unless ( 453 $sth = $self->do_query( 454 "ALTER TABLE %s ADD INDEX %s (%s)", $param->{'table'}, 455 $param->{'index_name'}, $fields 456 ) 457 ) { 458 $log->syslog( 459 'err', 460 'Could not add index %s using field %s for table %s in database %s', 461 $fields, 462 $param->{'table'}, 463 $self->{'db_name'} 464 ); 465 return undef; 466 } 467 my $report = sprintf 'Table %s, index %s set using fields %s', 468 $param->{'table'}, $param->{'index_name'}, $fields; 469 $log->syslog('info', 'Table %s, index %s set using fields %s', 470 $param->{'table'}, $param->{'index_name'}, $fields); 471 return $report; 472} 473 474## For DOUBLE type. 475sub AS_DOUBLE { 476 return ({'mysql_type' => DBD::mysql::FIELD_TYPE_DOUBLE()} => $_[1]) 477 if scalar @_ > 1; 478 return (); 479} 480 4811; 482__END__ 483 484=encoding utf-8 485 486=head1 NAME 487 488Sympa::DatabaseDriver::MySQL - Database driver for MySQL / MariaDB 489 490=head1 SEE ALSO 491 492L<Sympa::DatabaseDriver>. 493 494=cut 495