Commit 1841b00c authored by sikeda's avatar sikeda
Browse files

[dev] Refactoring on SQL drivers: Processing specific to each RDBMS were moved...

[dev] Refactoring on SQL drivers: Processing specific to each RDBMS were moved to each driver module.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@11800 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent 7ef3698d
......@@ -34,8 +34,7 @@ Subject: [% FILTER qencode %][%|loc%]No DataBase[%END%][%END%]
[% ELSIF type == 'missing_dbd' -%]
Subject: [% FILTER qencode %][%|loc(db_type)%]No DataBase Driver for %1[%END%][%END%]
[%|loc(db_type)%]No Database Driver installed for %1; you should download and install DBD::%1 from CPAN.[%END%]
[%|loc(db_type,db_module)%]No Database Driver installed for %1; you should download and install %2 from CPAN.[%END%]
[% ELSIF type == 'crash' -%]
Subject: [% FILTER qencode %][%|loc(crashed_process)%]Previous process %1 crashed[%END%][%END%]
......
......@@ -35,6 +35,7 @@ nobase_modules_DATA = \
Sympa/Crash.pm \
Sympa/DatabaseDescription.pm \
Sympa/DatabaseDriver.pm \
Sympa/DatabaseDriver/CSV.pm \
Sympa/DatabaseDriver/MySQL.pm \
Sympa/DatabaseDriver/ODBC.pm \
Sympa/DatabaseDriver/Oracle.pm \
......@@ -97,6 +98,7 @@ MAN3PM = \
Sympa/Crash.pm \
Sympa/DatabaseDescription.pm \
Sympa/DatabaseDriver.pm \
Sympa/DatabaseDriver/CSV.pm \
Sympa/DatabaseDriver/MySQL.pm \
Sympa/DatabaseDriver/ODBC.pm \
Sympa/DatabaseDriver/Oracle.pm \
......
......@@ -99,17 +99,8 @@ sub do_prepared_query {
## Note: if database connection is not available, this function returns
## immediately.
##
## NOT RECOMMENDED. Should not access to database handler.
sub db_get_handler {
Log::do_log('debug3', '');
if (check_db_connect('just_try')) {
return $db_source->{'dbh'};
} else {
Log::do_log('err', 'Unable to get a handle to Sympa database');
return undef;
}
}
## NO LONGER USED. Should not access to database handler.
#sub db_get_handler();
## Just check if DB connection is ok
## Possible option is 'just_try', won't try to reconnect if database
......@@ -123,9 +114,7 @@ sub check_db_connect {
return undef;
}
unless ($db_source
and $db_source->{'dbh'}
and $db_source->{'dbh'}->ping()) {
unless ($db_source and $db_source->ping) {
unless (connect_sympa_database(@options)) {
Log::do_log('err', 'Failed to connect to database');
return undef;
......@@ -158,7 +147,7 @@ sub connect_sympa_database {
$use_db = 1;
# Just in case, we connect to the database here. Probably not necessary.
unless ($db_source->{'dbh'} = $db_source->connect()) {
unless ($db_source->connect()) {
Log::do_log('err', 'Unable to connect to the Sympa database');
return undef;
}
......@@ -176,9 +165,7 @@ sub connect_sympa_database {
sub db_disconnect {
Log::do_log('debug2', '');
my $dbh = $db_source->{'dbh'};
$dbh->disconnect if $dbh;
delete $db_source->{'dbh'};
$db_source->disconnect if $db_source;
return 1;
}
......@@ -706,7 +693,7 @@ sub check_db_field_type {
sub quote {
my $param = shift;
if ($db_source and $db_source->{dbh}) {
if ($db_source and $db_source->__dbh) {
return $db_source->quote($param);
} else {
if (check_db_connect()) {
......@@ -720,7 +707,7 @@ sub quote {
sub get_substring_clause {
my $param = shift;
if ($db_source and $db_source->{dbh}) {
if ($db_source) {
return $db_source->get_substring_clause($param);
} else {
if (check_db_connect()) {
......@@ -742,7 +729,7 @@ sub get_substring_clause {
##
sub get_canonical_write_date {
my $param = shift;
if ($db_source and $db_source->{dbh}) {
if ($db_source) {
return $db_source->get_canonical_write_date($param);
} else {
if (check_db_connect()) {
......@@ -761,7 +748,7 @@ sub get_canonical_write_date {
##
sub get_canonical_read_date {
my $param = shift;
if ($db_source and $db_source->{dbh}) {
if ($db_source) {
return $db_source->get_canonical_read_date($param);
} else {
if (check_db_connect()) {
......
......@@ -31,6 +31,11 @@ use Log;
use base qw(Sympa::Datasource::SQL);
use constant required_modules => [];
use constant required_parameters => [qw(db_host db_name db_user db_passwd)];
use constant optional_parameters =>
[qw(db_port db_timeout db_options db_env)];
############################
#### Section containing generic functions #
#### without anything related to a specific RDBMS. #
......@@ -213,6 +218,24 @@ Sympa Database Manager (SDM).
=over
=item required_modules ( )
I<Overridable>.
Returns an arrayref including package name(s) this driver requires.
By default, no packages are required.
=item required_parameters ( )
I<Overridable>.
Returns an arrayref including names of required (not optional) parameters.
By default, returns C<['db_host', 'db_name', 'db_user', 'db_passwd']>.
=item optional_parameters ( )
I<Overridable>.
Returns an arrayref including all names of optional parameters.
By default, returns C<'db_port'>, C<'db_options'> and so on.
=item build_connect_string ( )
I<Mandatory>.
......@@ -226,6 +249,26 @@ Returns:
String representing data source name (DSN).
=item connect ( )
I<Overridable>.
Connects to database calling L</_connect>() and sets database handle.
Parameter:
None.
Returns:
True value or, if connection failed, false value.
=item _connect ( )
I<Overridable>.
Connects to database and returns native database handle.
The default implementation is for L<DBI> database handle.
=item get_substring_clause ( { source_field => $source_field,
separator => $separator, substring_length => $substring_length } )
......@@ -708,6 +751,18 @@ See L</AS_DOUBLE> for more details.
=back
=head2 Utility method
=over
=item __dbh ( )
I<Instance method>, I<protected>.
Returns native database handle which L<_connect>() returned.
This may be used at inside of each driver class.
=back
=head1 SEE ALSO
L<SDM>, L<Sympa::DatabaseDescription>.
......
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# 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
# Copyright (c) 2011, 2012, 2013, 2014, 2015 GIP RENATER
#
# 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
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::DatabaseDriver::CSV;
use strict;
use warnings;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::CSV)];
use constant required_parameters => [qw(f_dir)];
use constant optional_parameters => [qw(db_options)];
sub build_connect_string {
my $self = shift;
my $connect_string = 'DBI:CSV:f_dir=' . $self->{'f_dir'};
$connect_string .= ';' . $self->{'db_options'}
if defined $self->{'db_options'};
return $connect_string;
}
1;
=encoding utf-8
=head1 NAME
Sympa::DatabaseDriver::CSV - Database driver for CSV
=head1 SEE ALSO
L<Sympa::DatabaseDriver>, L<SDM>.
=cut
......@@ -29,10 +29,12 @@ use warnings;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::Informix)];
sub build_connect_string {
my $self = shift;
$self->{'connect_string'} =
"DBI:Informix:" . $self->{'db_name'} . "@" . $self->{'db_host'};
return 'DBI:Informix:' . $self->{'db_name'} . '@' . $self->{'db_host'};
}
1;
......@@ -26,18 +26,43 @@ package Sympa::DatabaseDriver::MySQL;
use strict;
use warnings;
#use Data::Dumper;
use Log;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::mysql)];
sub build_connect_string {
my $self = shift;
Log::do_log('debug', 'Building connection string to database %s',
$self->{'db_name'});
$self->{'connect_string'} =
"DBI:$self->{'db_type'}:$self->{'db_name'}:$self->{'db_host'}";
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'")) {
Log::do_log('err', 'Cannot set client-side character set: %s',
$self->__dbh->errstr);
}
return 1;
}
sub get_substring_clause {
......@@ -123,7 +148,7 @@ sub get_tables {
$self->{'db_name'});
my @raw_tables;
my @result;
unless (@raw_tables = $self->{'dbh'}->tables()) {
unless (@raw_tables = $self->__dbh->tables()) {
Log::do_log('err',
'Unable to retrieve the list of tables from database %s',
$self->{'db_name'});
......@@ -383,7 +408,6 @@ sub get_indexes {
$found_indexes{$index_name}{$field_name} = 1;
}
}
##open TMP, ">>/tmp/toto"; print TMP Dumper(\%found_indexes); close TMP;
return \%found_indexes;
}
......
......@@ -31,11 +31,13 @@ use Log;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::ODBC)];
use constant required_parameters => [qw(db_name db_user db_passwd)];
use constant optional_parameters => [];
sub build_connect_string {
my $self = shift;
Log::do_log('debug', 'Building connection string to database %s',
$self->{'db_name'});
$self->{'connect_string'} = "DBI:$self->{'db_type'}:$self->{'db_name'}";
return 'DBI:ODBC:' . $self->{'db_name'};
}
sub get_substring_clause {
......@@ -52,103 +54,6 @@ sub get_formatted_date {
die 'Not yet implemented: This is required by Sympa';
}
sub is_autoinc {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub set_autoinc {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub get_tables {
my $self = shift;
die 'Not yet implemented';
}
sub add_table {
my $self = shift;
my $param = shift;
die 'Not yet implemeneted';
}
sub get_fields {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub update_field {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub add_field {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub delete_field {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub get_primary_key {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub unset_primary_key {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub set_primary_key {
my $self = shift;
my $param = shift;
die 'Not yet impelemented';
}
sub get_indexes {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub unset_index {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub set_index {
my $self = shift;
my $param = shift;
die 'Not yet implemented';
}
sub AS_DOUBLE {
return ({'TYPE' => DBI::SQL_DOUBLE()} => $_[1])
if scalar @_ > 1;
......
......@@ -26,20 +26,50 @@ package Sympa::DatabaseDriver::Oracle;
use strict;
use warnings;
##use Data::Dumper;
use Sympa::DatabaseDriver::Oracle::St;
use Log;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::Oracle)];
sub build_connect_string {
my $self = shift;
$self->{'connect_string'} = "DBI:Oracle:";
if ($self->{'db_host'} && $self->{'db_name'}) {
$self->{'connect_string'} .=
"host=$self->{'db_host'};sid=$self->{'db_name'}";
my $connect_string = "DBI:Oracle:";
if ($self->{'db_host'} and $self->{'db_name'}) {
$connect_string .= "host=$self->{'db_host'};sid=$self->{'db_name'}";
}
$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.
# NLS_LANG needs to be set before connecting, otherwise it's useless.
# Underscore (_) and dot (.) are a vital part as NLS_LANG has the
# syntax "language_territory.charset".
#
# NOTE: "UTF8" should be overridden by "AL32UTF8" on Oracle 9i
# or later (use db_env). Former can't correctly handle characters
# beyond BMP.
$ENV{'NLS_LANG'} = '_.UTF8';
$self->SUPER::connect() or return undef;
# We set long preload length instead of defaulting to 80.
$self->__dbh->{LongReadLen} = 204800;
$self->__dbh->{LongTruncOk} = 0;
return 1;
}
sub get_substring_clause {
......@@ -416,7 +446,6 @@ sub get_indexes {
$found_indexes{$index_name}{$field_name} = 1;
}
}
##open TMP, ">>/tmp/toto"; print TMP Dumper(\%found_indexes); close TMP;
return \%found_indexes;
}
......
......@@ -31,11 +31,31 @@ use Log;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::Pg)];
sub build_connect_string {
my $self = shift;
Log::do_log('debug', 'Building connect string');
$self->{'connect_string'} =
my $connect_string =
"DBI:Pg:dbname=$self->{'db_name'};host=$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;
# - Configure Postgres to use ISO format dates.
# - Set client encoding to UTF8.
$self->__dbh->do("SET DATESTYLE TO 'ISO';");
$self->__dbh->do("SET NAMES 'utf8'");
return 1;
}
sub get_substring_clause {
......@@ -173,8 +193,8 @@ sub get_tables {
my %raw_tables;
foreach my $schema (@{$search_path || []}) {
my @tables =
$self->{'dbh'}
->tables(undef, $schema, undef, 'TABLE', {pg_noprefix => 1});
$self->__dbh->tables(undef, $schema, undef, 'TABLE',
{pg_noprefix => 1});
foreach my $t (@tables) {
next if $raw_tables{$t};
push @raw_tables, $t;
......
......@@ -34,10 +34,32 @@ use Log;
use base qw(Sympa::DatabaseDriver);
use constant required_modules => [qw(DBD::SQLite)];
use constant required_parameters => [qw(db_name)];
use constant optional_parameters => [qw(db_timeout)];
sub build_connect_string {
my $self = shift;
$self->{'connect_string'} =
"DBI:SQLite(sqlite_use_immediate_transaction=>1):dbname=$self->{'db_name'}";
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');
}
return 1;
}
sub get_substring_clause {
......@@ -126,7 +148,7 @@ sub get_tables {
my $self = shift;
my @raw_tables;
my @result;
unless (@raw_tables = $self->{'dbh'}->tables()) {
unless (@raw_tables = $self->__dbh->tables()) {
Log::do_log('err',
'Unable to retrieve the list of tables from database %s',
$self->{'db_name'});
......@@ -488,9 +510,9 @@ sub do_query {
);
## acquire "immediate" lock
unless (!$need_lock or $self->{'dbh'}->begin_work) {
unless (!$need_lock or $self->__dbh->begin_work) {
Log::do_log('err', 'Could not lock database: (%s) %s',
$self->{'dbh'}->err, $self->{'dbh'}->errstr);
$self->__dbh->err, $self->__dbh->errstr);
return undef;
}