MySQL.pm 14.4 KB
Newer Older
1
2
3
4
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

5
# Sympa - SYsteme de Multi-Postage Automatique
6
7
8
9
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11
12
13
# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the
# top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
14
15
16
17
18
19
20
21
22
23
24
25
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# 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::MySQL;
29
30

use strict;
31
use warnings;
32

33
use Sympa::Log;
34

35
use base qw(Sympa::DatabaseDriver);
36

37
38
my $log = Sympa::Log->instance;

39
40
use constant required_modules => [qw(DBD::mysql)];

41
42
sub build_connect_string {
    my $self = shift;
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

    my $connect_string =
        'DBI:mysql:' . $self->{'db_name'} . ':' . $self->{'db_host'};
    $connect_string .= ';port=' . $self->{'db_port'}
        if defined $self->{'db_port'};
    $connect_string .= ';' . $self->{'db_options'}
        if defined $self->{'db_options'};
    return $connect_string;
}

sub connect {
    my $self = shift;

    $self->SUPER::connect() or return undef;

    # - At first, reset "mysql_auto_reconnect" driver attribute.
    #   DBI::connect() sets it to true not according to \%attr argument
    #   when the processes are running under mod_perl or CGI environment
    #   so that "SET NAMES utf8" will be skipped.
    # - Set client-side character set to "utf8" or "utf8mb4".
    $self->__dbh->{'mysql_auto_reconnect'} = 0;
    unless (defined $self->__dbh->do("SET NAMES 'utf8mb4'")
        or defined $self->__dbh->do("SET NAMES 'utf8'")) {
66
        $log->syslog('err', 'Cannot set client-side character set: %s',
67
            $self->error);
68
69
70
    }

    return 1;
71
72
73
}

sub get_substring_clause {
74
    my $self  = shift;
75
    my $param = shift;
76
    $log->syslog('debug', 'Building substring caluse');
77
78
79
80
81
82
83
84
    return
          "REVERSE(SUBSTRING("
        . $param->{'source_field'}
        . " FROM position('"
        . $param->{'separator'} . "' IN "
        . $param->{'source_field'}
        . ") FOR "
        . $param->{'substring_length'} . "))";
85
86
}

87
88
# DEPRECATED.
#sub get_limit_clause ( { rows_count => $rows, offset => $offset } );
89

90
91
# DEPRECATED.
#sub get_formatted_date;
92
93

sub is_autoinc {
94
    my $self  = shift;
95
    my $param = shift;
96
    $log->syslog('debug', 'Checking whether field %s.%s is autoincremental',
97
        $param->{'field'}, $param->{'table'});
98
    my $sth;
99
100
101
102
103
104
105
    unless (
        $sth = $self->do_query(
            "SHOW FIELDS FROM `%s` WHERE Extra ='auto_increment' and Field = '%s'",
            $param->{'table'},
            $param->{'field'}
        )
        ) {
106
        $log->syslog('err',
107
108
109
110
111
            'Unable to gather autoincrement field named %s for table %s',
            $param->{'field'}, $param->{'table'});
        return undef;
    }
    my $ref = $sth->fetchrow_hashref('NAME_lc');
112
113
114
115
    return ($ref->{'field'} eq $param->{'field'});
}

sub set_autoinc {
116
    my $self  = shift;
117
    my $param = shift;
118
119
120
121
    my $field_type =
        defined($param->{'field_type'})
        ? $param->{'field_type'}
        : 'BIGINT( 20 )';
122
    $log->syslog('debug', 'Setting field %s.%s as autoincremental',
123
124
125
126
127
128
129
130
        $param->{'field'}, $param->{'table'});
    unless (
        $self->do_query(
            "ALTER TABLE `%s` CHANGE `%s` `%s` %s NOT NULL AUTO_INCREMENT",
            $param->{'table'}, $param->{'field'},
            $param->{'field'}, $field_type
        )
        ) {
131
        $log->syslog('err',
132
133
134
            'Unable to set field %s in table %s as autoincrement',
            $param->{'field'}, $param->{'table'});
        return undef;
135
136
137
138
139
140
    }
    return 1;
}

sub get_tables {
    my $self = shift;
141
    $log->syslog('debug', 'Retrieving all tables in database %s',
142
        $self->{'db_name'});
143
144
    my @raw_tables;
    my @result;
145
    unless (@raw_tables = $self->__dbh->tables()) {
146
        $log->syslog('err',
147
148
149
            'Unable to retrieve the list of tables from database %s',
            $self->{'db_name'});
        return undef;
150
    }
151

152
    foreach my $t (@raw_tables) {
153
154
155
156
157
158
159
        # Clean table names that would look like `databaseName`.`tableName`
        # (mysql)
        $t =~ s/^\`[^\`]+\`\.//;
        # Clean table names that could be surrounded by `` (recent DBD::mysql
        # release)
        $t =~ s/^\`(.+)\`$/$1/;
        push @result, $t;
160
161
162
163
164
    }
    return \@result;
}

sub add_table {
165
    my $self  = shift;
166
    my $param = shift;
167
    $log->syslog('debug', 'Adding table %s to database %s',
168
169
170
171
172
173
174
        $param->{'table'}, $self->{'db_name'});
    unless (
        $self->do_query(
            "CREATE TABLE %s (temporary INT) DEFAULT CHARACTER SET utf8",
            $param->{'table'}
        )
        ) {
175
        $log->syslog('err', 'Could not create table %s in database %s',
176
177
            $param->{'table'}, $self->{'db_name'});
        return undef;
178
    }
179
180
    return sprintf "Table %s created in database %s", $param->{'table'},
        $self->{'db_name'};
181
182
183
}

sub get_fields {
184
    my $self  = shift;
185
    my $param = shift;
186
    $log->syslog('debug', 'Getting fields list from table %s in database %s',
187
        $param->{'table'}, $self->{'db_name'});
188
189
    my $sth;
    my %result;
190
191
    unless ($sth = $self->do_query("SHOW FIELDS FROM %s", $param->{'table'}))
    {
192
        $log->syslog('err',
193
194
195
            'Could not get the list of fields from table %s in database %s',
            $param->{'table'}, $self->{'db_name'});
        return undef;
196
    }
197
198
    while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
        $result{$ref->{'field'}} = $ref->{'type'};
199
200
201
202
203
    }
    return \%result;
}

sub update_field {
204
    my $self  = shift;
205
    my $param = shift;
206
    $log->syslog('debug', 'Updating field %s in table %s (%s, %s)',
207
208
        $param->{'field'}, $param->{'table'}, $param->{'type'},
        $param->{'notnull'});
209
    my $options = '';
210
    if ($param->{'notnull'}) {
211
        $options .= ' NOT NULL ';
212
    }
213
214
215
216
217
    my $report = sprintf(
        "ALTER TABLE %s CHANGE %s %s %s %s",
        $param->{'table'}, $param->{'field'}, $param->{'field'},
        $param->{'type'},  $options
    );
218
    $log->syslog('notice', "ALTER TABLE %s CHANGE %s %s %s %s",
219
220
221
222
223
224
225
226
227
        $param->{'table'}, $param->{'field'}, $param->{'field'},
        $param->{'type'}, $options);
    unless (
        $self->do_query(
            "ALTER TABLE %s CHANGE %s %s %s %s",
            $param->{'table'}, $param->{'field'}, $param->{'field'},
            $param->{'type'},  $options
        )
        ) {
228
        $log->syslog('err', 'Could not change field "%s" in table "%s"',
229
230
            $param->{'field'}, $param->{'table'});
        return undef;
231
    }
232
233
    $report .= sprintf("\nField %s in table %s, structure updated",
        $param->{'field'}, $param->{'table'});
234
    $log->syslog('info', 'Field %s in table %s, structure updated',
235
        $param->{'field'}, $param->{'table'});
236
237
238
239
    return $report;
}

sub add_field {
240
    my $self  = shift;
241
    my $param = shift;
242
    $log->syslog(
243
244
245
246
247
        'debug',             'Adding field %s in table %s (%s, %s, %s, %s)',
        $param->{'field'},   $param->{'table'},
        $param->{'type'},    $param->{'notnull'},
        $param->{'autoinc'}, $param->{'primary'}
    );
248
    my $options = '';
249
250
    # To prevent "Cannot add a NOT NULL column with default value NULL" errors
    if ($param->{'notnull'}) {
251
        $options .= 'NOT NULL ';
252
    }
253
254
    if ($param->{'autoinc'}) {
        $options .= ' AUTO_INCREMENT ';
255
    }
256
257
    if ($param->{'primary'}) {
        $options .= ' PRIMARY KEY ';
258
    }
259
260
261
262
263
264
265
    unless (
        $self->do_query(
            "ALTER TABLE %s ADD %s %s %s", $param->{'table'},
            $param->{'field'},             $param->{'type'},
            $options
        )
        ) {
266
        $log->syslog('err',
267
268
269
            'Could not add field %s to table %s in database %s',
            $param->{'field'}, $param->{'table'}, $self->{'db_name'});
        return undef;
270
271
    }

272
273
    my $report = sprintf('Field %s added to table %s (options : %s)',
        $param->{'field'}, $param->{'table'}, $options);
274
    $log->syslog('info', 'Field %s added to table %s (options: %s)',
275
276
        $param->{'field'}, $param->{'table'}, $options);

277
278
279
280
    return $report;
}

sub delete_field {
281
    my $self  = shift;
282
    my $param = shift;
283
    $log->syslog('debug', 'Deleting field %s from table %s',
284
285
286
287
288
289
290
291
        $param->{'field'}, $param->{'table'});

    unless (
        $self->do_query(
            "ALTER TABLE %s DROP COLUMN `%s`", $param->{'table'},
            $param->{'field'}
        )
        ) {
292
        $log->syslog('err',
293
294
295
            'Could not delete field %s from table %s in database %s',
            $param->{'field'}, $param->{'table'}, $self->{'db_name'});
        return undef;
296
297
    }

298
299
    my $report = sprintf('Field %s removed from table %s',
        $param->{'field'}, $param->{'table'});
300
    $log->syslog('info', 'Field %s removed from table %s',
301
302
        $param->{'field'}, $param->{'table'});

303
304
305
306
    return $report;
}

sub get_primary_key {
307
    my $self  = shift;
308
    my $param = shift;
309
    $log->syslog('debug', 'Getting primary key for table %s',
310
        $param->{'table'});
311
312
313

    my %found_keys;
    my $sth;
314
315
    unless ($sth = $self->do_query("SHOW COLUMNS FROM %s", $param->{'table'}))
    {
316
        $log->syslog('err',
317
318
319
            'Could not get field list from table %s in database %s',
            $param->{'table'}, $self->{'db_name'});
        return undef;
320
321
322
    }

    my $test_request_result = $sth->fetchall_hashref('field');
323
324
325
326
    foreach my $scannedResult (keys %$test_request_result) {
        if ($test_request_result->{$scannedResult}{'key'} eq "PRI") {
            $found_keys{$scannedResult} = 1;
        }
327
328
329
330
331
    }
    return \%found_keys;
}

sub unset_primary_key {
332
    my $self  = shift;
333
    my $param = shift;
334
    $log->syslog('debug', 'Removing primary key from table %s',
335
        $param->{'table'});
336
337

    my $sth;
338
339
340
    unless ($sth =
        $self->do_query("ALTER TABLE %s DROP PRIMARY KEY", $param->{'table'}))
    {
341
        $log->syslog('err',
342
343
344
            'Could not drop primary key from table %s in database %s',
            $param->{'table'}, $self->{'db_name'});
        return undef;
345
346
    }
    my $report = "Table $param->{'table'}, PRIMARY KEY dropped";
347
    $log->syslog('info', 'Table %s, PRIMARY KEY dropped', $param->{'table'});
348
349
350
351
352

    return $report;
}

sub set_primary_key {
353
    my $self  = shift;
354
355
356
    my $param = shift;

    my $sth;
357
    my $fields = join ',', @{$param->{'fields'}};
358
    $log->syslog('debug', 'Setting primary key for table %s (%s)',
359
360
361
362
363
364
365
        $param->{'table'}, $fields);
    unless (
        $sth = $self->do_query(
            "ALTER TABLE %s ADD PRIMARY KEY (%s)", $param->{'table'},
            $fields
        )
        ) {
366
        $log->syslog(
367
368
369
370
371
372
373
            'err',
            'Could not set fields %s as primary key for table %s in database %s',
            $fields,
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
374
375
    }
    my $report = "Table $param->{'table'}, PRIMARY KEY set on $fields";
376
    $log->syslog('info', 'Table %s, PRIMARY KEY set on %s',
377
        $param->{'table'}, $fields);
378
379
380
381
    return $report;
}

sub get_indexes {
382
    my $self  = shift;
383
    my $param = shift;
384
    $log->syslog('debug', 'Looking for indexes in %s', $param->{'table'});
385
386
387

    my %found_indexes;
    my $sth;
388
    unless ($sth = $self->do_query("SHOW INDEX FROM %s", $param->{'table'})) {
389
        $log->syslog(
390
391
392
393
394
395
            'err',
            'Could not get the list of indexes from table %s in database %s',
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
396
397
    }
    my $index_part;
398
399
400
401
402
403
    while ($index_part = $sth->fetchrow_hashref('NAME_lc')) {
        if ($index_part->{'key_name'} ne "PRIMARY") {
            my $index_name = $index_part->{'key_name'};
            my $field_name = $index_part->{'column_name'};
            $found_indexes{$index_name}{$field_name} = 1;
        }
404
405
406
407
408
    }
    return \%found_indexes;
}

sub unset_index {
409
    my $self  = shift;
410
    my $param = shift;
411
    $log->syslog('debug', 'Removing index %s from table %s',
412
        $param->{'index'}, $param->{'table'});
413
414

    my $sth;
415
416
417
418
419
420
    unless (
        $sth = $self->do_query(
            "ALTER TABLE %s DROP INDEX %s", $param->{'table'},
            $param->{'index'}
        )
        ) {
421
        $log->syslog('err',
422
423
424
            'Could not drop index %s from table %s in database %s',
            $param->{'index'}, $param->{'table'}, $self->{'db_name'});
        return undef;
425
426
    }
    my $report = "Table $param->{'table'}, index $param->{'index'} dropped";
427
    $log->syslog('info', 'Table %s, index %s dropped',
428
        $param->{'table'}, $param->{'index'});
429
430
431
432
433

    return $report;
}

sub set_index {
434
    my $self  = shift;
435
436
437
    my $param = shift;

    my $sth;
438
    my $fields = join ',', @{$param->{'fields'}};
439
    $log->syslog(
440
441
442
443
444
445
446
447
448
449
450
        'debug',
        'Setting index %s for table %s using fields %s',
        $param->{'index_name'},
        $param->{'table'}, $fields
    );
    unless (
        $sth = $self->do_query(
            "ALTER TABLE %s ADD INDEX %s (%s)", $param->{'table'},
            $param->{'index_name'},             $fields
        )
        ) {
451
        $log->syslog(
452
453
454
455
456
457
458
            'err',
            'Could not add index %s using field %s for table %s in database %s',
            $fields,
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
459
460
    }
    my $report = "Table $param->{'table'}, index %s set using $fields";
461
    $log->syslog('info', 'Table %s, index %s set using fields %s',
462
        $param->{'table'}, $param->{'index_name'}, $fields);
463
464
    return $report;
}
465

466
467
## For DOUBLE type.
sub AS_DOUBLE {
468
469
    return ({'mysql_type' => DBD::mysql::FIELD_TYPE_DOUBLE()} => $_[1])
        if scalar @_ > 1;
470
471
472
    return ();
}

473
1;
474
475
476
477
478
479
__END__

=encoding utf-8

=head1 NAME

480
Sympa::DatabaseDriver::MySQL - Database driver for MySQL / MariaDB
481
482
483

=head1 SEE ALSO

sikeda's avatar
sikeda committed
484
L<Sympa::DatabaseDriver>.
485
486

=cut