Sybase.pm 14 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::Sybase;
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::Sybase)];

41
sub build_connect_string {
42
    my $self = shift;
43
44

    my $connect_string =
45
        "DBI:Sybase:database=$self->{'db_name'};server=$self->{'db_host'}";
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    $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;

    # Client encoding derived from the environment variable.
    # Set this before parsing db_env to allow override if one knows what
    # she is doing.
    $ENV{'SYBASE_CHARSET'} = 'utf8';

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

    $self->__dbh->do("use $self->{'db_name'}");

    # We set long preload length instead of defaulting to 32768.
    $self->__dbh->{LongReadLen} = 204800;
    $self->__dbh->{LongTruncOk} = 0;

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

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

sub get_tables {
    my $self = shift;
133
134
    my @raw_tables;
    my $sth;
135
136
137
138
139
140
    unless (
        $sth = $self->do_query(
            "SELECT name FROM %s..sysobjects WHERE type='U'",
            $self->{'db_name'}
        )
        ) {
141
        $log->syslog('err',
142
143
144
            'Unable to retrieve the list of tables from database %s',
            $self->{'db_name'});
        return undef;
145
    }
146
147
    while (my $table = $sth->fetchrow()) {
        push @raw_tables, lc($table);
148
149
    }
    return \@raw_tables;
150
151
152
}

sub add_table {
153
    my $self  = shift;
154
    my $param = shift;
155
    $log->syslog('debug', 'Adding table %s to database %s',
156
157
158
159
        $param->{'table'}, $self->{'db_name'});
    unless (
        $self->do_query("CREATE TABLE %s (temporary INT)", $param->{'table'}))
    {
160
        $log->syslog('err', 'Could not create table %s in database %s',
161
162
            $param->{'table'}, $self->{'db_name'});
        return undef;
163
    }
164
165
    return sprintf "Table %s created in database %s", $param->{'table'},
        $self->{'db_name'};
166
167
168
}

sub get_fields {
169
    my $self  = shift;
170
    my $param = shift;
171
    $log->syslog('debug', 'Getting fields list from table %s in database %s',
172
        $param->{'table'}, $self->{'db_name'});
173
174
    my $sth;
    my %result;
175
176
    unless ($sth = $self->do_query("SHOW FIELDS FROM %s", $param->{'table'}))
    {
177
        $log->syslog('err',
178
179
180
            'Could not get the list of fields from table %s in database %s',
            $param->{'table'}, $self->{'db_name'});
        return undef;
181
    }
182
183
    while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
        $result{$ref->{'field'}} = $ref->{'type'};
184
185
    }
    return \%result;
186
187
188
}

sub update_field {
189
    my $self  = shift;
190
    my $param = shift;
191
    $log->syslog('debug', 'Updating field %s in table %s (%s, %s)',
192
193
        $param->{'field'}, $param->{'table'}, $param->{'type'},
        $param->{'notnull'});
194
    my $options = '';
195
    if ($param->{'notnull'}) {
196
        $options .= ' NOT NULL ';
197
    }
198
199
200
201
202
    my $report = sprintf(
        "ALTER TABLE %s CHANGE %s %s %s %s",
        $param->{'table'}, $param->{'field'}, $param->{'field'},
        $param->{'type'},  $options
    );
203
    $log->syslog('notice', "ALTER TABLE %s CHANGE %s %s %s %s",
204
205
206
207
208
209
210
211
212
        $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
        )
        ) {
213
        $log->syslog('err', 'Could not change field "%s" in table "%s"',
214
215
            $param->{'field'}, $param->{'table'});
        return undef;
216
    }
217
218
    $report .= sprintf("\nField %s in table %s, structure updated",
        $param->{'field'}, $param->{'table'});
219
    $log->syslog('info', 'Field %s in table %s, structure updated',
220
        $param->{'field'}, $param->{'table'});
221
    return $report;
222
223
224
}

sub add_field {
225
    my $self  = shift;
226
    my $param = shift;
227
    $log->syslog(
228
229
230
231
232
        'debug',             'Adding field %s in table %s (%s, %s, %s, %s)',
        $param->{'field'},   $param->{'table'},
        $param->{'type'},    $param->{'notnull'},
        $param->{'autoinc'}, $param->{'primary'}
    );
233
    my $options = '';
234
235
    # To prevent "Cannot add a NOT NULL column with default value NULL" errors
    if ($param->{'notnull'}) {
236
        $options .= 'NOT NULL ';
237
    }
238
239
    if ($param->{'autoinc'}) {
        $options .= ' AUTO_INCREMENT ';
240
    }
241
242
    if ($param->{'primary'}) {
        $options .= ' PRIMARY KEY ';
243
    }
244
245
246
247
248
249
250
    unless (
        $self->do_query(
            "ALTER TABLE %s ADD %s %s %s", $param->{'table'},
            $param->{'field'},             $param->{'type'},
            $options
        )
        ) {
251
        $log->syslog('err',
252
253
254
            'Could not add field %s to table %s in database %s',
            $param->{'field'}, $param->{'table'}, $self->{'db_name'});
        return undef;
255
256
    }

257
258
    my $report = sprintf('Field %s added to table %s (options : %s)',
        $param->{'field'}, $param->{'table'}, $options);
259
    $log->syslog('info', 'Field %s added to table %s (options: %s)',
260
261
        $param->{'field'}, $param->{'table'}, $options);

262
263
264
265
    return $report;
}

sub delete_field {
266
    my $self  = shift;
267
    my $param = shift;
268
    $log->syslog('debug', 'Deleting field %s from table %s',
269
270
271
272
273
274
275
276
        $param->{'field'}, $param->{'table'});

    unless (
        $self->do_query(
            "ALTER TABLE %s DROP COLUMN `%s`", $param->{'table'},
            $param->{'field'}
        )
        ) {
277
        $log->syslog('err',
278
279
280
            'Could not delete field %s from table %s in database %s',
            $param->{'field'}, $param->{'table'}, $self->{'db_name'});
        return undef;
281
282
    }

283
284
    my $report = sprintf('Field %s removed from table %s',
        $param->{'field'}, $param->{'table'});
285
    $log->syslog('info', 'Field %s removed from table %s',
286
287
        $param->{'field'}, $param->{'table'});

288
289
290
291
    return $report;
}

sub get_primary_key {
292
    my $self  = shift;
293
    my $param = shift;
294
    $log->syslog('debug', 'Getting primary key for table %s',
295
        $param->{'table'});
296
297
298

    my %found_keys;
    my $sth;
299
300
    unless ($sth = $self->do_query("SHOW COLUMNS FROM %s", $param->{'table'}))
    {
301
        $log->syslog('err',
302
303
304
            'Could not get field list from table %s in database %s',
            $param->{'table'}, $self->{'db_name'});
        return undef;
305
306
307
    }

    my $test_request_result = $sth->fetchall_hashref('field');
308
309
310
311
    foreach my $scannedResult (keys %$test_request_result) {
        if ($test_request_result->{$scannedResult}{'key'} eq "PRI") {
            $found_keys{$scannedResult} = 1;
        }
312
313
314
315
316
    }
    return \%found_keys;
}

sub unset_primary_key {
317
    my $self  = shift;
318
    my $param = shift;
319
    $log->syslog('debug', 'Removing primary key from table %s',
320
        $param->{'table'});
321
322

    my $sth;
323
324
325
    unless ($sth =
        $self->do_query("ALTER TABLE %s DROP PRIMARY KEY", $param->{'table'}))
    {
326
        $log->syslog('err',
327
328
329
            'Could not drop primary key from table %s in database %s',
            $param->{'table'}, $self->{'db_name'});
        return undef;
330
331
    }
    my $report = "Table $param->{'table'}, PRIMARY KEY dropped";
332
    $log->syslog('info', 'Table %s, PRIMARY KEY dropped', $param->{'table'});
333
334
335
336
337

    return $report;
}

sub set_primary_key {
338
    my $self  = shift;
339
340
341
    my $param = shift;

    my $sth;
342
    my $fields = join ',', @{$param->{'fields'}};
343
    $log->syslog('debug', 'Setting primary key for table %s (%s)',
344
345
346
347
348
349
350
        $param->{'table'}, $fields);
    unless (
        $sth = $self->do_query(
            "ALTER TABLE %s ADD PRIMARY KEY (%s)", $param->{'table'},
            $fields
        )
        ) {
351
        $log->syslog(
352
353
354
355
356
357
358
            'err',
            'Could not set fields %s as primary key for table %s in database %s',
            $fields,
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
359
360
    }
    my $report = "Table $param->{'table'}, PRIMARY KEY set on $fields";
361
    $log->syslog('info', 'Table %s, PRIMARY KEY set on %s',
362
        $param->{'table'}, $fields);
363
364
365
366
    return $report;
}

sub get_indexes {
367
    my $self  = shift;
368
    my $param = shift;
369
    $log->syslog('debug', 'Looking for indexes in %s', $param->{'table'});
370
371
372

    my %found_indexes;
    my $sth;
373
    unless ($sth = $self->do_query("SHOW INDEX FROM %s", $param->{'table'})) {
374
        $log->syslog(
375
376
377
378
379
380
            'err',
            'Could not get the list of indexes from table %s in database %s',
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
381
382
    }
    my $index_part;
383
384
385
386
387
388
    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;
        }
389
390
391
392
393
    }
    return \%found_indexes;
}

sub unset_index {
394
    my $self  = shift;
395
    my $param = shift;
396
    $log->syslog('debug', 'Removing index %s from table %s',
397
        $param->{'index'}, $param->{'table'});
398
399

    my $sth;
400
401
402
403
404
405
    unless (
        $sth = $self->do_query(
            "ALTER TABLE %s DROP INDEX %s", $param->{'table'},
            $param->{'index'}
        )
        ) {
406
        $log->syslog('err',
407
408
409
            'Could not drop index %s from table %s in database %s',
            $param->{'index'}, $param->{'table'}, $self->{'db_name'});
        return undef;
410
411
    }
    my $report = "Table $param->{'table'}, index $param->{'index'} dropped";
412
    $log->syslog('info', 'Table %s, index %s dropped',
413
        $param->{'table'}, $param->{'index'});
414
415
416
417
418

    return $report;
}

sub set_index {
419
    my $self  = shift;
420
421
422
    my $param = shift;

    my $sth;
423
    my $fields = join ',', @{$param->{'fields'}};
424
    $log->syslog(
425
426
427
428
429
430
431
432
433
434
435
        '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
        )
        ) {
436
        $log->syslog(
437
438
439
440
441
442
443
            'err',
            'Could not add index %s using field %s for table %s in database %s',
            $fields,
            $param->{'table'},
            $self->{'db_name'}
        );
        return undef;
444
445
    }
    my $report = "Table $param->{'table'}, index %s set using $fields";
446
    $log->syslog('info', 'Table %s, index %s set using fields %s',
447
        $param->{'table'}, $param->{'index_name'}, $fields);
448
    return $report;
449
450
}

451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
sub translate_type {
    my $self = shift;
    my $type = shift;

    return undef unless $type;

    # Sybase
    $type =~ s/^int.*/numeric/g;
    $type =~ s/^text.*/varchar(500)/g;
    $type =~ s/^smallint.*/numeric/g;
    $type =~ s/^bigint.*/numeric/g;
    $type =~ s/^double/double precision/g;
    $type =~ s/^longtext.*/text/g;
    $type =~ s/^enum.*/varchar(15)/g;
    $type =~ s/^mediumblob/long binary/g;
    return $type;
}

469
1;
470
471
472
473
474
475
__END__

=encoding utf-8

=head1 NAME

476
Sympa::DatabaseDriver::Sybase - Database driver for Adaptive Server Enterprise
477
478
479

=head1 SEE ALSO

sikeda's avatar
sikeda committed
480
L<Sympa::DatabaseDriver>.
481
482

=cut