#!/usr/bin/perl

# -- Accounting & Hosting System
# (C) 2002 Dir.bg AD
# (C) 2002 Eugene Jerusalimov, mailto:Eugene@garp.ru


use warnings;
use strict;

use lib $ENV{'CF_SYSTEM_ROOT'}.'/lib/massmailer/perl',$ENV{'CF_SYSTEM_ROOT'}.'/lib/common/perl';

use CLI;

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

use Massmailer::Config;
use Massmailer::System;
use Massmailer::Scan;
$Massmailer::Scan::SKIP_MAIL_DOMAIN = [qw( abv.bg mail.bg gmail.com yahoo.com hotmail.com mail.ru mail.com )];
$Massmailer::Scan::warnings = 1; ## 1 by default

my $dbh = connect_db(DEFAULT_DB_NAME);
my $cli = connect_cgp() or die("mail server connection error: ".$!);

$Massmailer::Scan::cli = $cli;
$Massmailer::Scan::dbh = $dbh;


my $Maillist = get_maillist_queue();

foreach my $id_maillist (keys %$Maillist) {

	eval {

		$dbh->do("UPDATE maillist SET state=2, output='', last_update_dt=NOW(), last_update_by='Communigate' WHERE id=?", undef, $id_maillist)
			or die($dbh->errstr);

		check_maillist( $Maillist->{$id_maillist} );

		print "maillist #$id_maillist checked.\n";

		Massmailer::Scan::load_emails_list_from_db("SELECT email FROM maillist_email WHERE id_maillist=$id_maillist");

		print "emails loaded.\n";

		Massmailer::Scan::scan_emails();

		print "emails scanned.\n";

		my $EXCLUDED_EMAILS = _load_excluded_emails( $id_maillist );
		
		print "loaded ".scalar(keys %$EXCLUDED_EMAILS)." excluded emails.\n";

		$dbh->disconnect();

		my $real_qty = update_subscribers(
			$Maillist->{$id_maillist},
			Massmailer::Scan::save_to_arrayref(),
			$EXCLUDED_EMAILS
		);

		$dbh = connect_db(DEFAULT_DB_NAME);


		$dbh->do("UPDATE maillist SET state=3, real_qty=?, output='', last_update_dt=NOW(), last_update_by='Communigate', cgp_flag=1 WHERE id=?", undef, $real_qty, $id_maillist)
			or die($dbh->errstr);

		store_subscribers_list( $Maillist->{$id_maillist} );

		print "Maillst subscribers stored in the db.\n";
	};

	store_error($id_maillist, $@)
		if( $@ );
}

print "mailllist subscribers stored.\n"
	if scalar(keys %$Maillist);

purge_deleted_maillists();

$cli->Logout();

print "all done.\n"
	if scalar(keys %$Maillist);


sub get_maillist_queue
{
	my $SQL = <<SQL;
SELECT
	m.*,e.email
FROM
	maillist m,
	email e
WHERE
	m.state=1 AND
	m.email_qty>0 AND
	e.id=m.id_email
SQL

	return $dbh->selectall_hashref($SQL, 'id')
		or die $dbh->errstr;
}


sub _check_remove_maillist
{
	my $Maillist = shift or die "No maillist name given!";

	## check is maillist name changed
	my $last = $dbh->selectrow_arrayref("SELECT name FROM remove_maillist WHERE id_maillist=? AND name!='' ORDER BY id DESC LIMIT 0,1", undef, $Maillist->{'id'});

	if( $last->[0] && $last->[0] ne $Maillist->{'name'} ) {

		my $EXISTS = $cli->ListSubscribers($last->[0]);
		__store_tmp_subscribers($Maillist->{'id'}, $EXISTS)
			if $EXISTS && scalar @$EXISTS;

		unless( $cli->DeleteList($last->[0]) ) {
			die cli_err()
				if $cli->getErrMessage !~ /Unknown Mailing List/;
		}

		print "maillist $Maillist->{name} removed (name changed from $last->[0])\n";

		$dbh->do("DELETE FROM remove_maillist WHERE id_maillist=?", undef, $Maillist->{'id'})
			or die $dbh->errstr;

		return $EXISTS;
	}

	## check is owner email changed
	$last = $dbh->selectrow_arrayref("SELECT email FROM remove_maillist WHERE id_maillist=? AND email!='' ORDER BY id DESC LIMIT 0,1", undef, $Maillist->{'id'});

	if( $last->[0] && $last->[0] ne $Maillist->{'email'} ) {

		my $EXISTS = $cli->ListSubscribers($Maillist->{'name'});
		__store_tmp_subscribers($Maillist->{'id'}, $EXISTS)
			if $EXISTS && scalar @$EXISTS;

		unless( $cli->DeleteList($Maillist->{'name'}) ) {
			die cli_err()
				if $cli->getErrMessage !~ /Unknown Mailing List/;
		}

		print "maillist $Maillist->{name} removed (owner changed from $last->[0])\n";

		$dbh->do("DELETE FROM remove_maillist WHERE id_maillist=?", undef, $Maillist->{'id'})
			or die $dbh->errstr;

		return $EXISTS;
	}

	return undef;
}


sub purge_deleted_maillists
{
	my $data = $dbh->selectall_arrayref("SELECT id_maillist, delete_name FROM remove_maillist WHERE name='' AND email='' AND delete_name!=''")
        or die $dbh->errstr;

    foreach my $row (@$data) {
        $cli->DeleteList($row->[1])
            or die "Error for deleting maillist '$row->[1]':".$cli->getErrMessage;

        $dbh->do("DELETE FROM subscribed_email WHERE id_maillist=?", undef, $row->[0])
            or die $dbh->errstr;
        $dbh->do("DELETE FROM remove_maillist WHERE id_maillist=?", undef, $row->[0])
            or die $dbh->errstr;
	    
	## already deleted by admin script
        #$dbh->do("DELETE FROM exclude_email_maillist WHERE id_maillist=?", undef, $row->[0])
        #    or die $dbh->errstr;

        print "Maillist '$row->[1]' was deleted.\n";
    }

    return undef;
}

sub __store_tmp_subscribers
{
	my $id = shift;
	my $PREV_SUBSCR = shift;

	my $fname = "/tmp/massmailer-$id.bak.$$";

	open(F, ">$fname");
	print F join "\n", @$PREV_SUBSCR;
	close F;

	return undef;
}


sub __clean_tmp_subscribers
{
	my $id = shift;

	my $fname = "/tmp/massmailer-$id.bak.$$";
	unlink $fname;

	return undef;
}


sub check_maillist
{
	my $Maillist = shift or die "No maillist name given!";

	my $PREV_SUBSCR = _check_remove_maillist($Maillist);

	my $mailbox = $Maillist->{'email'};

	$cli->GetAccountSettings($mailbox) || die "Mailbox '$mailbox' doesn't exist!";

	my $List = $cli->GetAccountLists($mailbox)
		or die cli_err();

	if( defined $List->{__norm($Maillist->{'name'})} ) {
#			print "$Maillist->{'name'} Exists";
#			print Dumper $cli->GetList($Maillist->{'name'});
#			$cli->DeleteList($Maillist->{'name'})
#				or die cli_err();

	}
	else {
		$cli->CreateList($Maillist->{'name'}, __norm($mailbox))
			or die cli_err();

		my $DEFS = load_maillist_defaults();
		$DEFS->{'RealName'} = $Maillist->{'description'}
			if $Maillist->{'description'};
#			print Dumper $DEFS;

		$cli->UpdateList($Maillist->{'name'}, $DEFS)
			or die cli_err();

		print "maillist $Maillist->{name} created\n";

		if( $PREV_SUBSCR && scalar(@$PREV_SUBSCR) ) {

			$cli->List($Maillist->{'name'}, 'subscribe', $_, 'silently')
				|| die cli_err("Can't subscribe(2) '$_'")
				foreach (@$PREV_SUBSCR);

			print scalar(@$PREV_SUBSCR)." subscribers restored\n";
		}
	}

	__clean_tmp_subscribers($Maillist->{'id'})
		if $PREV_SUBSCR && scalar @$PREV_SUBSCR;

	return undef;
}


sub store_subscribers_list {
	my $Maillist = shift or die "No maillist name given!";

	my $EXISTS = $cli->ListSubscribers($Maillist->{'name'});

	$dbh->do("LOCK TABLES subscribed_email WRITE")
		or die $dbh->errstr;

	$dbh->do("DELETE FROM subscribed_email WHERE id_maillist=?", undef, $Maillist->{'id'})
		or die $dbh->errstr;

	my $sth = $dbh->prepare("INSERT INTO subscribed_email (id_maillist,email) VALUES ($Maillist->{id},?)")
		or die $dbh->errstr;

	foreach my $email (@$EXISTS) {
		$sth->execute($email)
			or die $sth->errstr;
	}

	$dbh->do("UNLOCK TABLES");

	return undef;
}


sub _load_excluded_emails
{
	my $id_maillist = shift or die "No id_maillist given!";

	my $SQL = "SELECT e.email FROM exclude_email_maillist AS em, exclude_email AS e WHERE em.id_maillist=? AND e.id=em.id_exclude_email";

	my $sth = $dbh->prepare($SQL) or die $dbh->errstr;
	$sth->execute($id_maillist) or die $sth->errstr;

	my $EXCLUDED = {};
	while( my $row = $sth->fetchrow_arrayref() ) {
		$EXCLUDED->{$row->[0]} = 1;
	}

	$sth->finish();

	return $EXCLUDED;
}


sub update_subscribers
{
	my $Maillist = shift or die "No maillist name given!";
	my $MM_EMAILS = shift or die "No emails list given!";
	my $EXCLUDED_EMAILS = shift or die "No excluded emails given";

	my $CG_EMAILS = $cli->ListSubscribers($Maillist->{'name'});
	
	print "Maillist '$Maillist->{name}' contains ".scalar(@$CG_EMAILS)." emails.\n";

	my ($SUBSCR, $UNSUBSCR) = _build_subscribers_diff_lists($CG_EMAILS, $MM_EMAILS);

	my $i = 0;
	my $total = scalar(@$SUBSCR);
	foreach my $email (@$SUBSCR) {
		print sprintf('%.02f', $i*100/$total)."%\n"
			if( ++$i % 1000 ==0 );

#print "subscribe $email\n";
		print cli_err("Can't subscribe '$email'")."\n"
			unless( $cli->List($Maillist->{'name'}, 'subscribe', $email, 'silently') );


			##or die cli_err("Can't subscribe $email");
	}

	print "$total emails subscribed.\n";

	$i = 0;
	$total = scalar(@$UNSUBSCR);
	foreach my $email (@$UNSUBSCR) {
		next
			unless defined $EXCLUDED_EMAILS->{$email};

print "unsubscribe '$email'\n";

		print cli_err("Can't unsubscribe '$email'")."\n"
			unless $cli->List($Maillist->{'name'}, 'unsubscribe', $email, 'silently');
			##or die cli_err("Can't unsubscribe $email");

		print sprintf('%.02f', $i*100/$total)."%\n"
			if( ++$i % 1000 ==0 );
	}

	print "$i of $total emails unsubscribed.\n";

	return scalar(@$CG_EMAILS) + scalar(@$SUBSCR) - scalar(@$UNSUBSCR)."\n";
}


sub _build_subscribers_diff_lists
{
	my $E = shift or die "No existing emails given!";
	my $N = shift or die "No new emails given!";

	my %E_hash = map { $_=>1 } @$E;
	my %N_hash = map { $_=>1 } @$N;

	my (@NEW,@DEL) = ((),());

	## search for new one
	foreach my $email ( keys %N_hash ) {
		push @NEW, $email
			unless( defined $E_hash{$email} );
	}

	## search for delete
	foreach my $email ( keys %E_hash ) {
		push @DEL, $email
			unless( defined $N_hash{$email} );
	}

	return (\@NEW, \@DEL);
}


sub store_error
{
	my $id_maillist = shift;
	my $error = shift;

	warn "ERROR: $id_maillist - $error\n";

	$dbh->do("UPDATE maillist SET state=3, output=? WHERE id=?", undef, $error, $id_maillist);

	return undef;
}


sub __norm
{
	return (split /\@/, shift)[0];
}


sub load_maillist_defaults
{
	open(F, "maillist.def") or die "Can't open maillist.def!";

	local $/;
	my $str = <F>;

	close F;

	my $VAR1;
	eval $str;

	return $VAR1;
}


sub cli_err
{
	my $err = shift;

	return "CGP: ".($err ? $err." " : '').$cli->getErrMessage." (".$cli->getErrCommand.")";
}
