Commit 18623843 authored by david.verdin's avatar david.verdin
Browse files

[change] Refactoring : All the code related to database and LDAP access was...

[change] Refactoring : All the code related to database and LDAP access was refactored. Main changes: 
	- new module SDM.pm : handles all the connection and access to the Sympa database. Now querying the Sympa database anywhere in the code can be done by calling: '&SDM::do_query($statement, @variables). all the connections, errors, statement preparation and executions are handled in the SDM module.
	- SQLSource and LDAPSource MUST now be manipulated through instances. the usage of class methods have been removed, because, with the exception of the Sympa database, all the usages are related to non-resident connections, so there is no usage of class instances and variables.



git-svn-id: https://subversion.renater.fr/sympa/trunk@7027 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent 35eb62ee
......@@ -56,7 +56,7 @@ $wwsconf->{'log_facility'}||= $Conf{'syslog'};
&Log::do_openlog($wwsconf->{'log_facility'}, $Conf{'log_socket_type'}, 'soap');
&Log::do_log('info', 'SOAP server launched');
unless ($List::use_db = &List::check_db_connect()) {
unless (&SDM::check_db_connect()) {
&do_log('err','SOAP server requires a RDBMS to run');
}
......
......@@ -81,7 +81,7 @@ unless (Conf::load($sympa_conf_file)) {
}
## Check database connectivity
unless (&List::check_db_connect()) {
unless (&SDM::check_db_connect()) {
&fatal_err('Database %s defined in sympa.conf has not the right structure or is unreachable.', $Conf::Conf{'db_name'});
}
......@@ -189,7 +189,7 @@ while (!$end) {
## disconnect from database before fork
## to prevent DB handlers to be shared by different processes
my $dbh = &List::db_get_handler();
my $dbh = &SDM::db_get_handler();
$dbh->disconnect; # when loading conf in database disconnect because of sharing dbh may crash bulk.pl
if($Conf::Conf{'bulk_max_count'} > 1) {
......
......@@ -32,6 +32,7 @@ unless (require Crypt::CipherSaber) {
require tools;
use List;
use SDM;
use Log;
## Load sympa config
......@@ -39,9 +40,9 @@ use Log;
chdir $Conf::Conf{'home'};
&List::db_connect() || die "Can't connect to database";
&SDM::db_connect() || die "Can't connect to database";
my $dbh = &List::db_get_handler();
my $dbh = &SDM::db_get_handler();
print "Searching uncrypted passwords\n";
......@@ -72,6 +73,7 @@ while ($user = $sth->fetchrow_hashref('NAME_lc')) {
$sth->finish();
&List::db_disconnect();
## Disconnect from Database
SDM::db_disconnect if ($SDM::dbh);
printf "Crypted %d passwords\n", $count;
......@@ -26,6 +26,7 @@ use wwslib;
use Sympa::Constants;
use List;
use SDM;
use Log;
## Load sympa config
......@@ -33,9 +34,9 @@ use Log;
chdir $Conf::Conf{'home'};
&List::db_connect() || die "Can't connect to database";
&SDM::db_connect() || die "Can't connect to database";
my $dbh = &List::db_get_handler();
my $dbh = &SDM::db_get_handler();
my $sth = $dbh->prepare("SELECT user_subscriber, comment_subscriber FROM subscriber_table") || die "Can't prepare SQL statement";
......@@ -68,4 +69,5 @@ while ($user = $sth->fetchrow_hashref('NAME_lc')) {
$sth->finish();
&List::db_disconnect();
## Disconnect from Database
SDM::db_disconnect if ($SDM::dbh);
This diff is collapsed.
......@@ -30,6 +30,7 @@ use Carp;
use Storable;
use List;
use SDM;
use Log;
use Language;
use wwslib;
......@@ -46,8 +47,7 @@ sub DAEMON_CREATION {4};
sub DAEMON_ALL {7};
## Database and SQL statement handlers
my ($dbh, $sth, $db_connected, @sth_stack, $use_db);
my $sth;
# parameters hash, keyed by parameter name
our %params =
map { $_->{name} => $_ }
......@@ -265,34 +265,15 @@ sub get_db_conf {
my $robot = shift;
my $label = shift;
$dbh = &List::db_get_handler();
my $sth;
# if the value is related to a robot that is not explicitly defined, apply it to the default robot.
$robot = '*' unless (-f $Conf{'etc'}.'/'.$robot.'/robot.conf') ;
unless ($robot) {$robot = '*'};
## Check database connection
unless ($dbh and $dbh->ping) {
return undef unless &List::db_connect();
$dbh = &List::db_get_handler();
}
my $statement = sprintf "SELECT value_conf AS value FROM conf_table WHERE (robot_conf =%s AND label_conf =%s)", $dbh->quote($robot),$dbh->quote($label);
unless ($sth = $dbh->prepare($statement)) {
do_log('err','Unable to prepare SQL statement: %s', $dbh->errstr);
return undef;
}
unless ($sth->execute) {
do_log('err','Unable to execute SQL statement "%s": %s', $statement, $dbh->errstr);
return undef;
}
unless ($dbh->do($statement)) {
do_log('err','Unable to execute SQL statement "%s": %s', $statement, $dbh->errstr);
return undef;
unless ($sth = &SDM::do_query("SELECT value_conf AS value FROM conf_table WHERE (robot_conf =%s AND label_conf =%s)", &SDM::quote($robot),&SDM::quote($label))) {
&Log::do_log('err','Unable retrieve value of parameter %s for robot %s from the database', $label, $robot);
return undef;
}
my $value = $sth->fetchrow;
$sth->finish();
......@@ -306,7 +287,7 @@ sub set_robot_conf {
my $label = shift;
my $value = shift;
do_log('info','Set config for robot %s , %s="%s"',$robot,$label, $value);
&Log::do_log('info','Set config for robot %s , %s="%s"',$robot,$label, $value);
# set the current config before to update database.
......@@ -317,53 +298,32 @@ sub set_robot_conf {
$robot = '*' ;
}
my $dbh = &List::db_get_handler();
my $sth;
my $statement = sprintf "SELECT count(*) FROM conf_table WHERE (robot_conf=%s AND label_conf =%s)", $dbh->quote($robot),$dbh->quote($label);
## Check database connection
unless ($dbh and $dbh->ping) {
return undef unless &db_connect();
}
unless ($sth = $dbh->prepare($statement)) {
do_log('err','Unable to prepare SQL statement: %s', $dbh->errstr);
return undef;
}
unless ($sth->execute) {
do_log('err','Unable to execute SQL statement "%s": %s', $statement, $dbh->errstr);
return undef;
}
unless ($dbh->do($statement)) {
do_log('err','Unable to execute SQL statement "%s": %s', $statement, $dbh->errstr);
next;
unless ($sth = &SDM::do_query("SELECT count(*) FROM conf_table WHERE (robot_conf=%s AND label_conf =%s)", &SDM::quote($robot),&SDM::quote($label))) {
&Log::do_log('err','Unable to check presence of parameter %s for robot %s in database', $label, $robot);
return undef;
}
my $count = $sth->fetchrow;
$sth->finish();
if ($count == 0) {
$statement = sprintf "INSERT INTO conf_table (robot_conf, label_conf, value_conf) VALUES (%s,%s,%s)",$dbh->quote($robot),$dbh->quote($label), $dbh->quote($value);
unless ($sth = &SDM::do_query("INSERT INTO conf_table (robot_conf, label_conf, value_conf) VALUES (%s,%s,%s)",&SDM::quote($robot),&SDM::quote($label), &SDM::quote($value))) {
&Log::do_log('err','Unable add value %s for parameter %s in the robot %s DB conf', $value, $label, $robot);
return undef;
}
}else{
$statement = sprintf "UPDATE conf_table SET robot_conf=%s, label_conf=%s, value_conf=%s WHERE ( robot_conf =%s AND label_conf =%s)",$dbh->quote($robot),$dbh->quote($label),$dbh->quote($value),$dbh->quote($robot),$dbh->quote($label);
}
unless ($sth = $dbh->prepare($statement)) {
do_log('err','Unable to prepare SQL statement: %s', $dbh->errstr);
return undef;
unless ($sth = &SDM::do_query("UPDATE conf_table SET robot_conf=%s, label_conf=%s, value_conf=%s WHERE ( robot_conf =%s AND label_conf =%s)",&SDM::quote($robot),&SDM::quote($label),&SDM::quote($value),&SDM::quote($robot),&SDM::quote($label))) {
&Log::do_log('err','Unable set parameter %s value to %s in the robot %s DB conf', $label, $value, $robot);
return undef;
}
}
unless ($sth->execute) {
do_log('err','Unable to execute SQL statement "%s": %s', $statement, $dbh->errstr);
return undef;
}
}
# Store configs to database
sub conf_2_db {
my $config_file = shift;
do_log('info',"conf_2_db");
&Log::do_log('info',"conf_2_db");
my @conf_parameters = @confdef::params ;
......@@ -419,7 +379,7 @@ sub checkfiles_as_root {
## Check aliases file
unless (-f $Conf{'sendmail_aliases'} || ($Conf{'sendmail_aliases'} =~ /^none$/i)) {
unless (open ALIASES, ">$Conf{'sendmail_aliases'}") {
&do_log('err',"Failed to create aliases file %s", $Conf{'sendmail_aliases'});
&Log::do_log('err',"Failed to create aliases file %s", $Conf{'sendmail_aliases'});
# printf STDERR "Failed to create aliases file %s", $Conf{'sendmail_aliases'};
return undef;
}
......@@ -427,14 +387,14 @@ sub checkfiles_as_root {
print ALIASES "## This aliases file is dedicated to Sympa Mailing List Manager\n";
print ALIASES "## You should edit your sendmail.mc or sendmail.cf file to declare it\n";
close ALIASES;
&do_log('notice', "Created missing file %s", $Conf{'sendmail_aliases'});
&Log::do_log('notice', "Created missing file %s", $Conf{'sendmail_aliases'});
unless (&tools::set_file_rights(file => $Conf{'sendmail_aliases'},
user => Sympa::Constants::USER,
group => Sympa::Constants::GROUP,
mode => 0644,
))
{
&do_log('err','Unable to set rights on %s',$Conf{'db_name'});
&Log::do_log('err','Unable to set rights on %s',$Conf{'db_name'});
return undef;
}
}
......@@ -445,7 +405,7 @@ sub checkfiles_as_root {
my $dir = &get_robot_conf($robot, 'static_content_path');
if ($dir ne '' && ! -d $dir){
unless ( mkdir ($dir, 0775)) {
&do_log('err', 'Unable to create directory %s: %s', $dir, $!);
&Log::do_log('err', 'Unable to create directory %s: %s', $dir, $!);
printf STDERR 'Unable to create directory %s: %s',$dir, $!;
$config_err++;
}
......@@ -455,7 +415,7 @@ sub checkfiles_as_root {
group => Sympa::Constants::GROUP,
))
{
&do_log('err','Unable to set rights on %s',$Conf{'db_name'});
&Log::do_log('err','Unable to set rights on %s',$Conf{'db_name'});
return undef;
}
}
......@@ -472,7 +432,7 @@ sub checkfiles {
next unless $Conf{$p};
unless (-x $Conf{$p}) {
do_log('err', "File %s does not exist or is not executable", $Conf{$p});
&Log::do_log('err', "File %s does not exist or is not executable", $Conf{$p});
$config_err++;
}
}
......@@ -480,9 +440,9 @@ sub checkfiles {
foreach my $qdir ('spool','queue','queueautomatic','queuedigest','queuemod','queuetopic','queueauth','queueoutgoing','queuebounce','queuesubscribe','queuetask','queuedistribute','tmpdir')
{
unless (-d $Conf{$qdir}) {
do_log('info', "creating spool $Conf{$qdir}");
&Log::do_log('info', "creating spool $Conf{$qdir}");
unless ( mkdir ($Conf{$qdir}, 0775)) {
do_log('err', 'Unable to create spool %s', $Conf{$qdir});
&Log::do_log('err', 'Unable to create spool %s', $Conf{$qdir});
$config_err++;
}
unless (&tools::set_file_rights(
......@@ -490,7 +450,7 @@ sub checkfiles {
user => Sympa::Constants::USER,
group => Sympa::Constants::GROUP,
)) {
&do_log('err','Unable to set rights on %s',$Conf{$qdir});
&Log::do_log('err','Unable to set rights on %s',$Conf{$qdir});
$config_err++;
}
}
......@@ -500,9 +460,9 @@ sub checkfiles {
foreach my $qdir ('queue','queuedistribute','queueautomatic') {
my $subdir = $Conf{$qdir}.'/bad';
unless (-d $subdir) {
do_log('info', "creating spool $subdir");
&Log::do_log('info', "creating spool $subdir");
unless ( mkdir ($subdir, 0775)) {
do_log('err', 'Unable to create spool %s', $subdir);
&Log::do_log('err', 'Unable to create spool %s', $subdir);
$config_err++;
}
unless (&tools::set_file_rights(
......@@ -510,7 +470,7 @@ sub checkfiles {
user => Sympa::Constants::USER,
group => Sympa::Constants::GROUP,
)) {
&do_log('err','Unable to set rights on %s',$subdir);
&Log::do_log('err','Unable to set rights on %s',$subdir);
$config_err++;
}
}
......@@ -519,9 +479,9 @@ sub checkfiles {
## Check cafile and capath access
if (defined $Conf{'cafile'} && $Conf{'cafile'}) {
unless (-f $Conf{'cafile'} && -r $Conf{'cafile'}) {
&do_log('err', 'Cannot access cafile %s', $Conf{'cafile'});
&Log::do_log('err', 'Cannot access cafile %s', $Conf{'cafile'});
unless (&List::send_notify_to_listmaster('cannot_access_cafile', $Conf{'domain'}, [$Conf{'cafile'}])) {
&do_log('err', 'Unable to send notify "cannot access cafile" to listmaster');
&Log::do_log('err', 'Unable to send notify "cannot access cafile" to listmaster');
}
$config_err++;
}
......@@ -529,9 +489,9 @@ sub checkfiles {
if (defined $Conf{'capath'} && $Conf{'capath'}) {
unless (-d $Conf{'capath'} && -x $Conf{'capath'}) {
&do_log('err', 'Cannot access capath %s', $Conf{'capath'});
&Log::do_log('err', 'Cannot access capath %s', $Conf{'capath'});
unless (&List::send_notify_to_listmaster('cannot_access_capath', $Conf{'domain'}, [$Conf{'capath'}])) {
&do_log('err', 'Unable to send notify "cannot access capath" to listmaster');
&Log::do_log('err', 'Unable to send notify "cannot access capath" to listmaster');
}
$config_err++;
}
......@@ -539,18 +499,18 @@ sub checkfiles {
## queuebounce and bounce_path pointing to the same directory
if ($Conf{'queuebounce'} eq $wwsconf->{'bounce_path'}) {
&do_log('err', 'Error in config: queuebounce and bounce_path parameters pointing to the same directory (%s)', $Conf{'queuebounce'});
&Log::do_log('err', 'Error in config: queuebounce and bounce_path parameters pointing to the same directory (%s)', $Conf{'queuebounce'});
unless (&List::send_notify_to_listmaster('queuebounce_and_bounce_path_are_the_same', $Conf{'domain'}, [$Conf{'queuebounce'}])) {
&do_log('err', 'Unable to send notify "queuebounce_and_bounce_path_are_the_same" to listmaster');
&Log::do_log('err', 'Unable to send notify "queuebounce_and_bounce_path_are_the_same" to listmaster');
}
$config_err++;
}
## automatic_list_creation enabled but queueautomatic pointing to queue
if (($Conf{automatic_list_feature} eq 'on') && $Conf{'queue'} eq $Conf{'queueautomatic'}) {
&do_log('err', 'Error in config: queue and queueautomatic parameters pointing to the same directory (%s)', $Conf{'queue'});
&Log::do_log('err', 'Error in config: queue and queueautomatic parameters pointing to the same directory (%s)', $Conf{'queue'});
unless (&List::send_notify_to_listmaster('queue_and_queueautomatic_are_the_same', $Conf{'domain'}, [$Conf{'queue'}])) {
&do_log('err', 'Unable to send notify "queue_and_queueautomatic_are_the_same" to listmaster');
&Log::do_log('err', 'Unable to send notify "queue_and_queueautomatic_are_the_same" to listmaster');
}
$config_err++;
}
......@@ -561,7 +521,7 @@ sub checkfiles {
if ($dir ne '' && -d $dir) {
unless (-f $dir.'/index.html'){
unless(open (FF, ">$dir".'/index.html')) {
&do_log('err', 'Unable to create %s/index.html as an empty file to protect directory: %s', $dir, $!);
&Log::do_log('err', 'Unable to create %s/index.html as an empty file to protect directory: %s', $dir, $!);
}
close FF;
}
......@@ -571,7 +531,7 @@ sub checkfiles {
my $pictures_dir = &get_robot_conf($robot, 'pictures_path');
unless (-d $pictures_dir){
unless (mkdir ($pictures_dir, 0775)) {
do_log('err', 'Unable to create directory %s',$pictures_dir);
&Log::do_log('err', 'Unable to create directory %s',$pictures_dir);
$config_err++;
}
chmod 0775, $pictures_dir;
......@@ -579,7 +539,7 @@ sub checkfiles {
my $index_path = $pictures_dir.'/index.html';
unless (-f $index_path){
unless (open (FF, ">$index_path")) {
&do_log('err', 'Unable to create %s as an empty file to protect directory', $index_path);
&Log::do_log('err', 'Unable to create %s as an empty file to protect directory', $index_path);
}
close FF;
}
......@@ -606,7 +566,7 @@ sub checkfiles {
unless (-d $dir) {
unless ( &tools::mkdir_all($dir, 0755)) {
&List::send_notify_to_listmaster('cannot_mkdir', $robot, ["Could not create directory $dir: $!"]);
&do_log('err','Failed to create directory %s',$dir);
&Log::do_log('err','Failed to create directory %s',$dir);
return undef;
}
}
......@@ -619,14 +579,14 @@ sub checkfiles {
## Update the CSS if it is missing or if a new css.tt2 was installed
if (! -f $dir.'/'.$css ||
(stat($css_tt2_path))[9] > (stat($dir.'/'.$css))[9]) {
&do_log('notice',"TT2 file $css_tt2_path has changed; updating static CSS file $dir/$css ; previous file renamed");
&Log::do_log('notice',"TT2 file $css_tt2_path has changed; updating static CSS file $dir/$css ; previous file renamed");
## Keep copy of previous file
rename $dir.'/'.$css, $dir.'/'.$css.'.'.time;
unless (open (CSS,">$dir/$css")) {
&List::send_notify_to_listmaster('cannot_open_file', $robot, ["Could not open file $dir/$css: $!"]);
&do_log('err','Failed to open (write) file %s',$dir.'/'.$css);
&Log::do_log('err','Failed to open (write) file %s',$dir.'/'.$css);
return undef;
}
......@@ -634,7 +594,7 @@ sub checkfiles {
my $error = &tt2::get_error();
$param->{'tt2_error'} = $error;
&List::send_notify_to_listmaster('web_tt2_error', $robot, [$error]);
&do_log('err', "Error while installing $dir/$css");
&Log::do_log('err', "Error while installing $dir/$css");
}
$css_updated ++;
......@@ -665,19 +625,19 @@ sub valid_robot {
## Missing etc directory
unless (-d $Conf{'etc'}.'/'.$robot) {
&do_log('err', 'Robot %s undefined ; no %s directory', $robot, $Conf{'etc'}.'/'.$robot);
&Log::do_log('err', 'Robot %s undefined ; no %s directory', $robot, $Conf{'etc'}.'/'.$robot);
return undef;
}
## Missing expl directory
unless (-d $Conf{'home'}.'/'.$robot) {
&do_log('err', 'Robot %s undefined ; no %s directory', $robot, $Conf{'home'}.'/'.$robot);
&Log::do_log('err', 'Robot %s undefined ; no %s directory', $robot, $Conf{'home'}.'/'.$robot);
return undef;
}
## Robot not loaded
unless (defined $Conf{'robots'}{$robot}) {
&do_log('err', 'Robot %s was not loaded by this Sympa process', $robot);
&Log::do_log('err', 'Robot %s was not loaded by this Sympa process', $robot);
return undef;
}
......@@ -694,7 +654,7 @@ sub get_sso_by_id {
}
foreach my $sso (@{$Conf{'auth_services'}{$param{'robot'}}}) {
&do_log('notice', "SSO: $sso->{'service_id'}");
&Log::do_log('notice', "SSO: $sso->{'service_id'}");
next unless ($sso->{'service_id'} eq $param{'service_id'});
return $sso;
......@@ -713,7 +673,7 @@ sub _load_auth {
my $is_main_robot = shift;
# find appropriate auth.conf file
my $config_file = &_get_config_file_name({'robot' => $robot, 'file' => "auth.conf"});
&do_log('debug', 'Conf::_load_auth(%s)', $config_file);
&Log::do_log('debug', 'Conf::_load_auth(%s)', $config_file);
$robot ||= $Conf{'domain'};
my $line_num = 0;
......@@ -793,7 +753,7 @@ sub _load_auth {
## Open the configuration file or return and read the lines.
unless (open(IN, $config_file)) {
do_log('notice',"_load_auth: Unable to open %s: %s", $config_file, $!);
&Log::do_log('notice',"_load_auth: Unable to open %s: %s", $config_file, $!);
return undef;
}
......@@ -816,11 +776,11 @@ sub _load_auth {
}elsif (/^\s*(\S+)\s+(.*\S)\s*$/o){
my ($keyword,$value) = ($1,$2);
unless (defined $valid_keywords{$current_paragraph->{'auth_type'}}{$keyword}) {
do_log('err',"_load_auth: unknown keyword '%s' in %s line %d", $keyword, $config_file, $line_num);
&Log::do_log('err',"_load_auth: unknown keyword '%s' in %s line %d", $keyword, $config_file, $line_num);
next;
}
unless ($value =~ /^$valid_keywords{$current_paragraph->{'auth_type'}}{$keyword}$/) {
do_log('err',"_load_auth: unknown format '%s' for keyword '%s' in %s line %d", $value, $keyword, $config_file,$line_num);
&Log::do_log('err',"_load_auth: unknown format '%s' for keyword '%s' in %s line %d", $value, $keyword, $config_file,$line_num);
next;
}
......@@ -838,13 +798,13 @@ sub _load_auth {
if ($current_paragraph->{'auth_type'} eq 'cas') {
unless (defined $current_paragraph->{'base_url'}) {
&do_log('err','Incorrect CAS paragraph in auth.conf');
&Log::do_log('err','Incorrect CAS paragraph in auth.conf');
next;
}
eval "require AuthCAS";
if ($@) {
&do_log('err', 'Failed to load AuthCAS perl module');
&Log::do_log('err', 'Failed to load AuthCAS perl module');
return undef;
}
......@@ -865,7 +825,7 @@ sub _load_auth {
$current_paragraph->{'cas_server'} = new AuthCAS(%{$cas_param});
unless (defined $current_paragraph->{'cas_server'}) {
&do_log('err', 'Failed to create CAS object for %s: %s',
&Log::do_log('err', 'Failed to create CAS object for %s: %s',
$current_paragraph->{'base_url'}, &AuthCAS::get_errors());
next;
}
......@@ -1406,7 +1366,7 @@ sub _infer_server_specific_parameter_values {
if ($log_condition =~ /^\s*(ip|email)\s*\=\s*(.*)\s*$/i) {
$param->{'config_hash'}{'loging_condition'}{$1} = $2;
}else{
&do_log('err',"unrecognized log_condition token %s ; ignored",$log_condition);
&Log::do_log('err',"unrecognized log_condition token %s ; ignored",$log_condition);
}
}
......@@ -1684,7 +1644,7 @@ sub _save_binary_cache {
my $param = shift;
my $lock = new Lock ($param->{'target_file'});
unless (defined $lock) {
&do_log('err','Could not create new lock');
&Log::do_log('err','Could not create new lock');
return undef;
}
$lock->set_timeout(2);
......@@ -1718,7 +1678,7 @@ sub _load_binary_cache {
my $lock = new Lock ($param->{'config_file'});
unless (defined $lock) {
&do_log('err','Could not create new lock');
&Log::do_log('err','Could not create new lock');
return undef;
}
$lock->set_timeout(2);
......
# DefaultDBManipulator.pm - This module contains default manipulation functions.
# DBManipulatorDefault.pm - This module contains default manipulation functions.
# they are used if not defined in the DBManipulator<*> subclasses.
#<!-- RCS Identication ; $Revision: 7016 $ -->
#
......@@ -20,7 +20,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package DefaultDBManipulator;
package DBManipulatorDefault;
use strict;
......@@ -31,9 +31,55 @@ use Datasource;
our @ISA = qw(Datasource);
sub build_connect_string{
sub build_connect_string {
my $self = shift;
$self->{'connect_string'} = "DBI:$self->{'db_type'}:$self->{'db_name'}:$self->{'db_host'}";
}
## Returns an SQL clause to be inserted in a query.
## This clause will compute a substring of max length
## $param->{'substring_length'} starting from the first character equal
## to $param->{'separator'} found in the value of field $param->{'source_field'}.
sub get_substring_clause {
my $self = shift;
my $param = shift;
return "REVERSE(SUBSTRING(".$param->{'source_field'}." FROM position('".$param->{'separator'}."' IN ".$param->{'source_field'}.") FOR ".$param->{'substring_length'}."))";
}
## Returns an SQL clause to be inserted in a query.
## This clause will limit the number of records returned by the query to
## $param->{'rows_count'}. If $param->{'offset'} is provided, an offset of
## $param->{'offset'} rows is done from the first record before selecting
## the rows to return.
sub get_limit_clause {
my $self = shift;
my $param = shift;
if ($param->{'offset'}) {
return "LIMIT ".$param->{'offset'}.",".$param->{'rows_count'};
}else{
return "LIMIT ".$param->{'rows_count'};
}
}
## Returns a character string corresponding to the expression to use in a query
## involving a date.
## Takes a hash as argument which can contain the following keys:
## * 'mode'
## authorized values:
## - 'write': the sub returns the expression to use in 'INSERT' or 'UPDATE' queries
## - 'read': the sub returns the expression to use in 'SELECT' queries
## * 'target': the name of the field or the value to be used in the query
##
sub get_formatted_date {
my $self = shift;
my $param = shift;
if (lc($param->{'mode'}) eq 'read') {
return sprintf 'UNIX_TIMESTAMP(%s)',$param->{'target'};
}elsif(lc($param->{'mode'}) eq 'write') {
return sprintf 'FROM_UNIXTIME(%d)',$param->{'target'};
}else {
&Log::do_log('err',"Unknown date format mode %s", $param->{'mode'});
return undef;
}
}
return 1;
......@@ -26,13 +26,19 @@ use strict;
use Carp;
use Log;
use DefaultDBManipulator;
use DBManipulatorDefault;
our @ISA = qw(DefaultDBManipulator);
our @ISA = qw(DBManipulatorDefault);
sub build_connect_string{
my $self = shift;
$self->{'connect_string'} = "DBI:$self->{'db_type'}:$self->{'db_name'}:$self->{'db_host'}";
}
##################### WARNING ##############################
### DO NOT ADD ANY FUNCTION TO THIS MODULE ! ###
### It is empty on purpose: The MySQL operations queries ###
### are the default in Sympa. So all the MySQL-specific subs ###
### are located in DBManipulatorDefault.pm. ###
### ###
### We keep a MySQL module because the reference RDBMS could ###