#!/usr/bin/perl
# Custom archiver can be used to replace mhonac. The goal is to store messages in a database

 use lib '/usr/local/sympa-sa/bin';
use strict;
use Getopt::Long;
use Carp;
use Log;
use Mail::Header;
use Mail::Internet;
use Mail::Address;
use MIME::Entity;
use MIME::EncWords;
use MIME::Parser;
use DBI;
# use SQLSource;


## Database and SQL statement handlers
my $dbh;


my %db_params ;
$db_params{'db_host'} = 'localhost';
$db_params{'db_type'} = 'mysql';
$db_params{'db_name'} = 'custom_archive';
$db_params{'db_table'} = 'archive';
$db_params{'db_user'} = 'toto';
$db_params{'db_passwd'} = 'tutu';


my %options;
unless (&GetOptions(\%main::options, 'file=s', 'list=s')){
    printf STDERR "Usage: $0 --file=<filename> --list=<listname>\n";
    exit (0);
}

unless (open FILE, $main::options{'file'}) {
    &do_log('err', 'Cannot open message file %s : %s',  $main::options{'file'}, $!);
    exit (0);
}

my $parser = new MIME::Parser;
$parser->output_to_core(1);

my $msg;
unless ($msg = $parser->read(\*FILE)) {
    do_log('err', 'Unable to parse message %s', $main::options{'file'});
    close FILE;
    exit(0);
}

unless ( $dbh = db_connect(\%db_params )) {
    printf STDERR "could not connect to database\n";
    exit 0;
}

my $message_id = $msg->head->get('Message-Id');
my $group_id = $main::options{'list'};
my $timestamp = time();
my $subject = $msg->head->get('Subject');
#my $uid = $msg->head->get('X-UID');
my $uid = $msg->head->get('From');# Comment this line (used for CRU testing purpose) and uncomment the line above to use your own X-UID headers.
my $msg_as_string = $msg->as_string;

my $statement = sprintf "INSERT INTO $db_params{'db_table'} (message_id,group_id,timestamp,subject,message,uid ) VALUES (%s, %s, %s, %s, %s, %s)",$dbh->quote($message_id), $dbh->quote($group_id), $dbh->quote($timestamp), $dbh->quote($subject), $dbh->quote($msg_as_string), $dbh->quote($uid);

unless ($dbh->do($statement)) {
    printf STDERR "could not store message in database\n";
exit (0);
}

exit ;

sub db_connect{
    my $param = shift;

    my $connect_string;
    ## Check if DBD is installed

#    unless (eval "require DBB::$param->{'db_type'}") {
#	printf STDERR "No Database Driver installed for $param->{'db_type'} ; you should download and install DBD::$param->{'db_type'} from CPAN";
#	return undef;
#    }
    if ($param->{'db_type'} eq 'Oracle') {
	$connect_string = "DBI:Oracle:";
	if ($param->{'db_host'} && $param->{'db_name'}) {
	    $connect_string .= "host=$param->{'db_host'};sid=$param->{'db_name'}";
	}
	if (defined $param->{'db_port'}) {
	    $connect_string .= ';port=' . $param->{'db_port'};
	}
    }elsif ($param->{'db_type'} eq 'Pg') {
	$connect_string = "DBI:Pg:dbname=$param->{'db_name'};host=$param->{'db_host'}";
    }elsif ($param->{'db_type'} eq 'Sybase') {
	$connect_string = "DBI:Sybase:database=$param->{'db_name'};server=$param->{'db_host'}";
    }elsif ($param->{'db_type'} eq 'SQLite') {
	$connect_string = "DBI:SQLite:dbname=$param->{'db_name'}";
    }elsif ($param->{'db_type'} eq 'Informix') {
        $connect_string = "DBI:Informix:".$param->{'db_name'}."@".$param->{'db_host'}; 
    }else {
	$connect_string = "DBI:$param->{'db_type'}:$param->{'db_name'}:$param->{'db_host'}";
    }
    
    if ($param->{'db_options'}) {
	$connect_string .= ';' . $param->{'db_options'};
    }
    if (defined $param->{'db_port'}) {
	$connect_string .= ';port=' . $param->{'db_port'};
    }
    
    ## Set environment variables
    ## Used by Oracle (ORACLE_HOME)
    if ($param->{'db_env'}) {
	foreach my $env (split /;/,$param->{'db_env'}) {
	    my ($key, $value) = split /=/, $env;
	    $ENV{$key} = $value if ($key);
	}
    }
    
    my $dbh;
    
    ## Loop until connect works
    my $sleep_delay = 1;
    while (1) {
	sleep $sleep_delay;
	$dbh = DBI->connect($connect_string, $param->{'db_user'}, $param->{'db_passwd'});
	last if ($dbh && $dbh->ping());
	$sleep_delay += 10;
	if ($sleep_delay >= 120){
	    printf STDERR 'could not connect to database  %s as %s', $connect_string, $param->{'db_user'};
	    return undef;
	}
    }
          
    if ($param->{'db_type'} eq 'Pg') { # Configure Postgres to use ISO format dates
	$dbh->do ("SET DATESTYLE TO 'ISO';");
    }
    
    ## Set client encoding to UTF8
    if ($param->{'db_type'} eq 'mysql' ||
	$param->{'db_type'} eq 'Pg') {
	$dbh->do("SET NAMES 'utf8'");
    }elsif ($param->{'db_type'} eq 'oracle') { 
	$ENV{'NLS_LANG'} = 'UTF8';
    }elsif ($param->{'db_type'} eq 'Sybase') { 
	$ENV{'SYBASE_CHARSET'} = 'utf8';
    }
    
    ## added sybase support
    if ($param->{'db_type'} eq 'Sybase') { 
	my $dbname;
	$dbname="use $param->{'db_name'}";
        $dbh->do ($dbname);
    }
    
    ## Force field names to be lowercased
    ## This has has been added after some problems of field names upercased with Oracle
    $dbh->{'FetchHashKeyName'}='NAME_lc';
    
    return $dbh;
}