SQLite.pm 23.7 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
# Copyright 2018, 2021 The Sympa Community. See the
# AUTHORS.md file at the top-level directory of this distribution and at
13
# <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::SQLite;
29
30

use strict;
31
use warnings;
32
use DBI qw();
33
use English qw(-no_match_vars);
34
use POSIX qw();
35

36
use Sympa::Log;
37

38
use base qw(Sympa::DatabaseDriver);
39

40
41
my $log = Sympa::Log->instance;

42
43
44
45
use constant required_modules    => [qw(DBD::SQLite)];
use constant required_parameters => [qw(db_name)];
use constant optional_parameters => [qw(db_timeout)];

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

    return 'DBI:SQLite(sqlite_use_immediate_transaction=>1):dbname='
        . $self->{'db_name'};
}

sub connect {
    my $self = shift;

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

    # Configure to use sympa database
    $self->__dbh->func('func_index', -1, sub { return index($_[0], $_[1]) },
        'create_function');
    if (defined $self->{'db_timeout'}) {
        $self->__dbh->func($self->{'db_timeout'}, 'busy_timeout');
    } else {
        $self->__dbh->func(5000, 'busy_timeout');
    }
66
67
    # Create a temoprarhy view "dual" for portable SQL statements.
    $self->__dbh->do(q{CREATE TEMPORARY VIEW dual AS SELECT 'X' AS dummy;});
68
69

    return 1;
70
71
}

72
sub get_substring_clause {
73
    my $self  = shift;
74
    my $param = shift;
75
76
77
78
79
80
81
    return
          "substr("
        . $param->{'source_field'}
        . ",func_index("
        . $param->{'source_field'} . ",'"
        . $param->{'separator'} . "')+1,"
        . $param->{'substring_length'} . ")";
82
83
}

84
85
# DEPRECATED.
#sub get_limit_clause ( { rows_count => $rows, offset => $offset } );
86

87
88
# DEPRECATED.
#sub get_formatted_date;
89

90
sub is_autoinc {
91
    my $self  = shift;
92
    my $param = shift;
93
94
95
    my $table = $param->{'table'};
    my $field = $param->{'field'};

96
    $log->syslog('debug', 'Checking whether field %s.%s is autoincremental',
97
        $table, $field);
98
99
100

    my $type = $self->_get_field_type($table, $field);
    return undef unless $type;
101
    return ($type =~ /\binteger PRIMARY KEY\b/i) ? 1 : 0;
102
103
104
}

sub set_autoinc {
105
    my $self  = shift;
106
    my $param = shift;
107
108
109
    my $table = $param->{'table'};
    my $field = $param->{'field'};

110
    $log->syslog('debug', 'Setting field %s.%s as autoincremental',
111
        $table, $field);
112
113
114
115
116
117

    my $type = $self->_get_field_type($table, $field);
    return undef unless $type;

    my $r;
    my $pk;
sikeda's avatar
sikeda committed
118
    if ($type =~ /\binteger\s+PRIMARY\s+KEY\b/i) {
119
120
        ## INTEGER PRIMARY KEY is auto-increment.
        return 1;
121
    } elsif ($type =~ /\bPRIMARY\s+KEY\b/i) {
122
123
124
125
126
127
128
129
130
        $r = $self->_update_table($table, qr(\b$field\s[^,]+),
            "$field\tinteger PRIMARY KEY");
    } elsif ($pk =
            $self->get_primary_key({'table' => $table})
        and $pk->{$field}
        and scalar keys %$pk == 1) {
        $self->unset_primary_key({'table' => $table});
        $r = $self->_update_table($table, qr(\b$field\s[^,]+),
            "$field\tinteger PRIMARY KEY");
131
    } else {
132
133
        $r = $self->_update_table($table, qr(\b$field\s[^,]+),
            "$field\t$type AUTOINCREMENT");
134
135
136
    }

    unless ($r) {
137
        $log->syslog('err',
138
139
140
            'Unable to set field %s in table %s as autoincrement',
            $field, $table);
        return undef;
141
142
    }
    return 1;
143
144
145
146
}

sub get_tables {
    my $self = shift;
147
148
    my @raw_tables;
    my @result;
149
    unless (@raw_tables = $self->__dbh->tables()) {
150
        $log->syslog('err',
151
152
153
            'Unable to retrieve the list of tables from database %s',
            $self->{'db_name'});
        return undef;
154
    }
155

156
    foreach my $t (@raw_tables) {
157
        $t =~ s/^"main"\.//;    # needed for SQLite 3
158
159
        $t =~ s/^.*\"([^\"]+)\"$/$1/;
        push @result, $t;
160
161
    }
    return \@result;
162
163
164
}

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
        $param->{'table'}, $self->{'db_name'});
    unless (
        $self->do_query("CREATE TABLE %s (temporary INT)", $param->{'table'}))
    {
172
        $log->syslog('err', 'Could not create table %s in database %s',
173
174
175
176
177
            $param->{'table'}, $self->{'db_name'});
        return undef;
    }
    return sprintf "Table %s created in database %s", $param->{'table'},
        $self->{'db_name'};
178
179
180
}

sub get_fields {
181
    my $self  = shift;
182
    my $param = shift;
183
    my $table = $param->{'table'};
184
185
    my $sth;
    my %result;
186
    unless ($sth = $self->do_query(q{PRAGMA table_info('%s')}, $table)) {
187
        $log->syslog('err',
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
            'Could not get the list of fields from table %s in database %s',
            $table, $self->{'db_name'});
        return undef;
    }
    while (my $field = $sth->fetchrow_hashref('NAME_lc')) {
        # http://www.sqlite.org/datatype3.html
        my $type = $field->{'type'};
        if ($type =~ /int/) {
            $type = 'integer';
        } elsif ($type =~ /char|clob|text/) {
            $type = 'text';
        } elsif ($type =~ /blob|none/) {
            $type = 'none';
        } elsif ($type =~ /real|floa|doub/) {
            $type = 'real';
203
        } elsif ($type =~ /timestamp/) {    # for compatibility to SQLite 2.
204
            $type = 'timestamp';
205
206
207
208
        } else {
            $type = 'numeric';
        }
        $result{$field->{'name'}} = $type;
209
210
    }
    return \%result;
211
}
212

213
sub update_field {
214
215
216
217
    my $self    = shift;
    my $param   = shift;
    my $table   = $param->{'table'};
    my $field   = $param->{'field'};
218
    my $type    = $param->{'type'};
219
    my $options = '';
220
    if ($param->{'notnull'}) {
221
        $options .= ' NOT NULL ';
222
    }
223
224
    my $report;

225
    $log->syslog('debug', 'Updating field %s in table %s (%s%s)',
226
227
        $field, $table, $type, $options);

228
    my $r = $self->_update_table($table, qr(\b$field\s[^,]+),
229
        "$field\t$type$options");
230
    unless (defined $r) {
231
        $log->syslog('err', 'Could not update field %s in table %s (%s%s)',
232
            $field, $table, $type, $options);
233
        return undef;
234
    }
235
    $report = $r;
236
    $log->syslog('info', '%s', $r);
237
238
239
240
241
242
243
244
245

    # Conversion between timestamp and number is not obvious.
    # So convert explicitly.
    my $fields = $self->get_fields({'table' => $table});
    if ($fields->{$field} eq 'timestamp' and $type =~ /^number/i) {
        $self->do_query('UPDATE %s SET %s = strftime(\'%%s\', %s, \'utc\')',
            $table, $field, $field);
    }

246
    $report .= "\nTable $table, field $field updated";
247
    $log->syslog('info', 'Table %s, field %s updated', $table, $field);
248

249
    return $report;
250
251
252
}

sub add_field {
253
    my $self  = shift;
254
    my $param = shift;
255
256
257
    my $table = $param->{'table'};
    my $field = $param->{'field'};

258
    $log->syslog(
259
260
261
262
263
        'debug',             'Adding field %s in table %s (%s, %s, %s, %s)',
        $field,              $table,
        $param->{'type'},    $param->{'notnull'},
        $param->{'autoinc'}, $param->{'primary'}
    );
264
    my $options = '';
265
    # To prevent "Cannot add a NOT NULL column with default value NULL" errors
266
    if ($param->{'primary'}) {
267
        $options .= ' PRIMARY KEY';
268
    }
269
270
    if ($param->{'autoinc'}) {
        $options .= ' AUTOINCREMENT';
271
    }
272
273
    if ($param->{'notnull'}) {
        $options .= ' NOT NULL';
274
    }
275
276
277
278

    my $report = '';

    if ($param->{'primary'}) {
279
280
281
        $report = $self->_update_table($table, qr{[(]\s*},
            "(\n\t $field\t$param->{'type'}$options,\n\t ");
        unless (defined $report) {
282
            $log->syslog('err',
283
284
285
286
287
288
289
290
291
292
                'Could not add field %s to table %s in database %s',
                $field, $table, $self->{'db_name'});
            return undef;
        }
    } else {
        unless (
            $self->do_query(
                q{ALTER TABLE %s ADD %s %s%s},
                $table, $field, $param->{'type'}, $options
            )
Luc Didry's avatar
Luc Didry committed
293
        ) {
294
            $log->syslog('err',
295
296
297
298
                'Could not add field %s to table %s in database %s',
                $field, $table, $self->{'db_name'});
            return undef;
        }
299
300
    }

301
302
    $report .= "\n" if $report;
    $report .= sprintf 'Field %s added to table %s (%s%s)',
303
        $field, $table, $param->{'type'}, $options;
304
    $log->syslog('info', 'Field %s added to table %s (%s%s)',
305
        $field, $table, $param->{'type'}, $options);
306

307
308
309
310
    return $report;
}

sub delete_field {
311
    my $self  = shift;
312
    my $param = shift;
313
314
    my $table = $param->{'table'};
    my $field = $param->{'field'};
315

316
317
    return '' if $field eq 'temporary';

318
    $log->syslog('debug', 'Deleting field %s from table %s', $field, $table);
319
320

    ## SQLite does not support removal of columns
321
322
    my $report =
        "Could not remove field $field from table $table since SQLite does not support removal of columns";
323
    $log->syslog('info', '%s', $report);
324
325
326
327
328

    return $report;
}

sub get_primary_key {
329
    my $self  = shift;
330
    my $param = shift;
331
    my $table = $param->{'table'};
332
    $log->syslog('debug', 'Getting primary key for table %s', $table);
333
334

    my %found_keys = ();
335
336

    my $sth;
337
    unless ($sth = $self->do_query(q{PRAGMA table_info('%s')}, $table)) {
338
        $log->syslog('err',
339
340
341
            'Could not get field list from table %s in database %s',
            $table, $self->{'db_name'});
        return undef;
342
    }
343
344
    my $l;
    while ($l = $sth->fetchrow_hashref('NAME_lc')) {
345
346
        next unless $l->{'pk'};
        $found_keys{$l->{'name'}} = 1;
347
    }
348
349
    $sth->finish;

350
351
352
353
    return \%found_keys;
}

sub unset_primary_key {
354
    my $self  = shift;
355
    my $param = shift;
356
357
358
    my $table = $param->{'table'};
    my $report;

359
    $log->syslog('debug', 'Removing primary key from table %s', $table);
360
361
    my $r =
        $self->_update_table($table, qr{,\s*PRIMARY\s+KEY\s+[(][^)]+[)]}, '');
362
    unless (defined $r) {
363
364
365
366
367
368
369
        $r = $self->_update_table($table, qr{(?<=integer)\s+PRIMARY\s+KEY},
            '');
        unless (defined $r) {
            $log->syslog('err', 'Could not remove primary key from table %s',
                $table);
            return undef;
        }
370
    }
371
    $report = $r;
372
    $log->syslog('info', '%s', $r);
373
    $report .= "\nTable $table, PRIMARY KEY dropped";
374
    $log->syslog('info', 'Table %s, PRIMARY KEY dropped', $table);
375
376
377
378
379

    return $report;
}

sub set_primary_key {
380
381
382
383
    my $self   = shift;
    my $param  = shift;
    my $table  = $param->{'table'};
    my $fields = join ',', @{$param->{'fields'}};
384
385
    my $report;

386
    $log->syslog('debug', 'Setting primary key for table %s (%s)',
387
388
389
        $table, $fields);
    my $r = $self->_update_table($table, qr{\s*[)]\s*$},
        ",\n\t PRIMARY KEY ($fields)\n )");
390
    unless (defined $r) {
391
        $log->syslog('debug', 'Could not set primary key for table %s (%s)',
392
393
            $table, $fields);
        return undef;
394
    }
395
    $report = $r;
396
    $log->syslog('info', '%s', $r);
397
    $report .= "\nTable $table, PRIMARY KEY set on $fields";
398
    $log->syslog('info', 'Table %s, PRIMARY KEY set on %s', $table, $fields);
399

400
401
402
403
    return $report;
}

sub get_indexes {
404
    my $self  = shift;
405
    my $param = shift;
406
    $log->syslog('debug', 'Looking for indexes in %s', $param->{'table'});
407
408
409

    my %found_indexes;
    my $sth;
410
    my $l;
411
412
    unless ($sth =
        $self->do_query(q{PRAGMA index_list('%s')}, $param->{'table'})) {
413
        $log->syslog(
414
415
416
417
418
419
            'err',
            'Could not get the list of indexes from table %s in database %s',
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
420
    }
421
422
423
    while ($l = $sth->fetchrow_hashref('NAME_lc')) {
        next if $l->{'unique'};
        $found_indexes{$l->{'name'}} = {};
424
425
426
427
    }
    $sth->finish;

    foreach my $index_name (keys %found_indexes) {
428
429
        unless ($sth =
            $self->do_query(q{PRAGMA index_info('%s')}, $index_name)) {
430
            $log->syslog(
431
432
433
434
435
436
437
438
439
440
441
                'err',
                'Could not get the list of indexes from table %s in database %s',
                $param->{'table'},
                $self->{'db_name'}
            );
            return undef;
        }
        while ($l = $sth->fetchrow_hashref('NAME_lc')) {
            $found_indexes{$index_name}{$l->{'name'}} = {};
        }
        $sth->finish;
442
    }
443

444
445
446
447
    return \%found_indexes;
}

sub unset_index {
448
    my $self  = shift;
449
    my $param = shift;
450
    $log->syslog('debug', 'Removing index %s from table %s',
451
        $param->{'index'}, $param->{'table'});
452
453

    my $sth;
Luc Didry's avatar
Luc Didry committed
454
455
    unless ($sth =
        $self->do_query(q{DROP INDEX IF EXISTS "%s"}, $param->{'index'})) {
456
        $log->syslog('err',
457
458
459
            'Could not drop index %s from table %s in database %s',
            $param->{'index'}, $param->{'table'}, $self->{'db_name'});
        return undef;
460
461
    }
    my $report = "Table $param->{'table'}, index $param->{'index'} dropped";
462
    $log->syslog('info', 'Table %s, index %s dropped',
463
        $param->{'table'}, $param->{'index'});
464
465
466
467
468

    return $report;
}

sub set_index {
469
    my $self  = shift;
470
471
472
    my $param = shift;

    my $sth;
473
    my $fields = join ',', @{$param->{'fields'}};
474
    $log->syslog(
475
476
477
478
479
480
481
482
483
484
        'debug',
        'Setting index %s for table %s using fields %s',
        $param->{'index_name'},
        $param->{'table'}, $fields
    );
    unless (
        $sth = $self->do_query(
            q{CREATE INDEX %s ON %s (%s)}, $param->{'index_name'},
            $param->{'table'},             $fields
        )
Luc Didry's avatar
Luc Didry committed
485
    ) {
486
        $log->syslog(
487
488
489
490
491
492
493
            'err',
            'Could not add index %s using field %s for table %s in database %s',
            $fields,
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
494
    }
495
496
    my $report = sprintf 'Table %s, index %s set using fields %s',
        $param->{'table'}, $param->{'index_name'}, $fields;
497
    $log->syslog('info', 'Table %s, index %s set using fields %s',
498
        $param->{'table'}, $param->{'index_name'}, $fields);
499
    return $report;
500
501
}

502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
sub translate_type {
    my $self = shift;
    my $type = shift;

    return undef unless $type;

    # SQLite
    $type =~ s/^varchar.*/text/g;
    $type =~ s/^.*int\(1\).*/numeric/g;
    $type =~ s/^int.*/integer/g;
    $type =~ s/^tinyint.*/integer/g;
    $type =~ s/^bigint.*/integer/g;
    $type =~ s/^smallint.*/integer/g;
    $type =~ s/^double/real/g;
    $type =~ s/^longtext.*/text/g;
    $type =~ s/^datetime.*/numeric/g;
    $type =~ s/^enum.*/text/g;
    $type =~ s/^mediumblob/none/g;
    return $type;
}

523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
# As SQLite does not support nested transactions, these are not effective
# during when {_transaction_level} attribute is positive, i.e. only the
# outermost transaction will be available.
sub begin {
    my $self = shift;

    $self->{_transaction_level} //= 0;

    if ($self->{_transaction_level}++) {
        return 1;
    }
    return $self->SUPER::begin;
}

sub commit {
    my $self = shift;

    unless ($self->{_transaction_level}) {
        die 'bug in logic. Ask developer';
    }
    if (--$self->{_transaction_level}) {
        return 1;
    }
    return $self->SUPER::commit;
}

sub rollback {
    my $self = shift;

    unless ($self->{_transaction_level}) {
        die 'bug in logic. Ask developer';
    }
    if (--$self->{_transaction_level}) {
        return 1;
    }
    return $self->SUPER::rollback;
}

561
# Note:
562
563
564
565
566
# - To prevent "database is locked" error, acquire "immediate" lock
#   by each query.  Most queries excluding "SELECT" need to lock in this
#   manner.
# - If a transaction has been begun, lock is not needed, because SQLite
#   does not support nested transactions.
567
568
569
570
571
572
sub do_query {
    my $self = shift;
    my $sth;
    my $rc;

    my $need_lock =
573
        ($_[0] =~
574
575
            /^\s*(ALTER|CREATE|DELETE|DROP|INSERT|REINDEX|REPLACE|UPDATE)\b/i)
        unless $self->{_transaction_level};
576
577

    ## acquire "immediate" lock
578
    unless (!$need_lock or $self->__dbh->begin_work) {
579
        $log->syslog('err', 'Could not lock database: %s', $self->error);
580
        return undef;
581
582
583
584
585
586
587
588
    }

    ## do query
    $sth = $self->SUPER::do_query(@_);

    ## release lock
    return $sth unless $need_lock;
    eval {
589
        if ($sth) {
590
            $rc = $self->__dbh->commit;
591
        } else {
592
            $rc = $self->__dbh->rollback;
593
        }
594
    };
595
    if ($EVAL_ERROR or !$rc) {
596
        $log->syslog(
sikeda's avatar
sikeda committed
597
598
599
600
            'err',
            'Could not unlock database: %s',
            $EVAL_ERROR || $self->error
        );
601
        return undef;
602
603
604
605
606
607
608
609
610
611
612
    }

    return $sth;
}

sub do_prepared_query {
    my $self = shift;
    my $sth;
    my $rc;

    my $need_lock =
613
        ($_[0] =~
614
615
            /^\s*(ALTER|CREATE|DELETE|DROP|INSERT|REINDEX|REPLACE|UPDATE)\b/i)
        unless $self->{_transaction_level};
616
617

    ## acquire "immediate" lock
618
    unless (!$need_lock or $self->__dbh->begin_work) {
619
        $log->syslog('err', 'Could not lock database: %s', $self->error);
620
        return undef;
621
622
623
624
625
626
627
628
    }

    ## do query
    $sth = $self->SUPER::do_prepared_query(@_);

    ## release lock
    return $sth unless $need_lock;
    eval {
629
        if ($sth) {
630
            $rc = $self->__dbh->commit;
631
        } else {
632
            $rc = $self->__dbh->rollback;
633
        }
634
    };
635
    if ($EVAL_ERROR or !$rc) {
636
        $log->syslog(
sikeda's avatar
sikeda committed
637
638
639
640
            'err',
            'Could not unlock database: %s',
            $EVAL_ERROR || $self->error
        );
641
        return undef;
642
643
644
645
646
647
    }

    return $sth;
}

sub AS_BLOB {
648
649
    return ({TYPE => DBI::SQL_BLOB()} => $_[1])
        if scalar @_ > 1;
650
651
652
    return ();
}

653
# Private methods
654

655
# Get raw type of column
656
sub _get_field_type {
657
    my $self  = shift;
658
659
660
661
662
    my $table = shift;
    my $field = shift;

    my $sth;
    unless ($sth = $self->do_query(q{PRAGMA table_info('%s')}, $table)) {
663
        $log->syslog('err',
664
665
666
            'Could not get the list of fields from table %s in database %s',
            $table, $self->{'db_name'});
        return undef;
667
668
669
    }
    my $l;
    while ($l = $sth->fetchrow_hashref('NAME_lc')) {
670
671
        if (lc $l->{'name'} eq lc $field) {
            $sth->finish;
672
673
674
675
676
            return
                  $l->{'type'}
                . ($l->{'pk'}         ? ' PRIMARY KEY'                : '')
                . ($l->{'notnull'}    ? ' NOT NULL'                   : '')
                . ($l->{'dflt_value'} ? " DEFAULT $l->{'dflt_value'}" : '');
677
        }
678
679
680
    }
    $sth->finish;

681
    $log->syslog(
682
683
684
685
686
687
        'err',
        'Could not gather information of field %s from table %s in database %s',
        $field,
        $table,
        $self->{'db_name'}
    );
688
689
690
    return undef;
}

691
692
# Update table structure
# Old table will be saved as "<table name>_<YYmmddHHMMSS>_<PID>".
693
sub _update_table {
694
695
696
    my $self        = shift;
    my $table       = shift;
    my $regex       = shift;
697
698
699
    my $replacement = shift;
    my $statement;
    my $table_saved = sprintf '%s_%s_%d', $table,
700
        POSIX::strftime("%Y%m%d%H%M%S", gmtime $^T),
701
        $PID;
702
703
704
705
706
    my $report;

    ## create temporary table with new structure
    $statement = $self->_get_create_table($table);
    unless (defined $statement) {
707
        $log->syslog('err', 'Table "%s" does not exist', $table);
708
        return undef;
709
    }
710

711
712
    $statement =~
        s/^\s*CREATE\s+TABLE\s+([\"\w]+)/CREATE TABLE ${table_saved}_new/;
sikeda's avatar
sikeda committed
713
714

    my $statement_orig = $statement;
715
    $statement =~ s/$regex/$replacement/;
716
    if ($statement eq $statement_orig) {
717
        $log->syslog('debug', 'Table "%s" was not changed', $table);
718
719
720
721
        return undef;
    }
    $statement =~ s/\btemporary\s+INT,\s*//;    # Omit "temporary" field.

722
723
724
    my $s = $statement;
    $s =~ s/\n\s*/ /g;
    $s =~ s/\t/ /g;
725
    $log->syslog('info', '%s', $s);
726

727
    unless ($self->do_query('%s', $statement)) {
728
        $log->syslog('err', 'Could not create temporary table "%s_new"',
729
730
            $table_saved);
        return undef;
731
732
    }

733
    $log->syslog('info', 'Copy "%s" to "%s_new"', $table, $table_saved);
734
    ## save old table
735
736
737
738
739
    my $indexes = $self->get_indexes({'table' => $table});
    unless (defined $self->_copy_table($table, "${table_saved}_new")
        and defined $self->_rename_or_drop_table($table, $table_saved)
        and defined $self->_rename_table("${table_saved}_new", $table)) {
        return undef;
740
741
742
    }
    ## recreate indexes
    foreach my $name (keys %{$indexes || {}}) {
743
744
745
746
747
748
749
750
751
752
        unless (
            defined $self->unset_index(
                {'table' => "${table_saved}_new", 'index' => $name}
            )
            and defined $self->set_index(
                {   'table'      => $table,
                    'index_name' => $name,
                    'fields'     => [sort keys %{$indexes->{$name}}]
                }
            )
Luc Didry's avatar
Luc Didry committed
753
        ) {
754
755
            return undef;
        }
756
757
758
759
760
761
    }

    $report = "Old table was saved as \'$table_saved\'";
    return $report;
}

762
# Get SQL statement by which table was created.
763
sub _get_create_table {
764
    my $self  = shift;
765
766
767
    my $table = shift;
    my $sth;

768
769
770
    unless (
        $sth = $self->do_query(
            q{SELECT sql
771
772
              FROM sqlite_master
              WHERE type = 'table' AND name = '%s'},
773
774
            $table
        )
Luc Didry's avatar
Luc Didry committed
775
    ) {
776
        $log->syslog('Could not get table \'%s\' on database \'%s\'',
777
778
            $table, $self->{'db_name'});
        return undef;
779
780
781
782
783
784
785
    }
    my $sql = $sth->fetchrow_array();
    $sth->finish;

    return $sql || undef;
}

786
787
# Copy table content to another table
# Target table must have all columns source table has.
788
sub _copy_table {
789
790
    my $self      = shift;
    my $table     = shift;
791
792
793
    my $table_new = shift;
    return undef unless defined $table and defined $table_new;

794
    my $fields = join ', ', grep { $_ ne 'temporary' }
795
        sort keys %{$self->get_fields({'table' => $table})};
796
    $fields ||= 'temporary';
797
798

    my $sth;
799
800
801
802
803
    unless (
        $sth = $self->do_query(
            q{INSERT INTO "%s" (%s) SELECT %s FROM "%s"},
            $table_new, $fields, $fields, $table
        )
Luc Didry's avatar
Luc Didry committed
804
    ) {
805
        $log->syslog('err',
806
            'Could not copy talbe "%s" to temporary table "%s_new"',
807
808
            $table, $table_new);
        return undef;
809
810
811
812
813
    }

    return 1;
}

814
815
# Rename table
# If target already exists, do nothing and return 0.
816
sub _rename_table {
817
818
    my $self      = shift;
    my $table     = shift;
819
820
821
822
    my $table_new = shift;
    return undef unless defined $table and defined $table_new;

    if ($self->_get_create_table($table_new)) {
823
        return 0;
824
    }
825
826
    unless (
        $self->do_query(q{ALTER TABLE %s RENAME TO %s}, $table, $table_new)) {
827
        $log->syslog('err', 'Could not rename table "%s" to "%s"',
828
829
            $table, $table_new);
        return undef;
830
831
832
833
    }
    return 1;
}

834
835
# Rename table
# If target already exists, drop source table.
836
sub _rename_or_drop_table {
837
838
    my $self      = shift;
    my $table     = shift;
839
840
841
842
    my $table_new = shift;

    my $r = $self->_rename_table($table, $table_new);
    unless (defined $r) {
843
        return undef;
844
    } elsif ($r) {
845
        return $r;
846
    } else {
847
        unless ($self->do_query(q{DROP TABLE IF EXISTS "%s"}, $table)) {
848
            $log->syslog('err', 'Could not drop table "%s"', $table);
849
850
851
            return undef;
        }
        return 0;
852
853
854
855
    }
}

1;
856
857
858
859
860
861
__END__

=encoding utf-8

=head1 NAME

862
Sympa::DatabaseDriver::SQLite - Database driver for SQLite
863
864
865

=head1 SEE ALSO

sikeda's avatar
sikeda committed
866
L<Sympa::DatabaseDriver>.
867
868

=cut