# ==================================================================
# Gossamer Mail - enhanced email management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: Purge.pm,v 1.20 2004/05/17 23:12:02 brewt Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

package GMail::Admin::Purge;

use strict;
use vars qw/@ISA $ERRORS/;

use GMail qw/:admin_returns :objects ADMIN/;
use GMail::Admin;

use GT::SQL::Condition;

@ISA = qw(GMail::Admin);
$ERRORS = {
    SEARCHERR_NORESULTS => "No search results",
};

sub users_purge {
# -------------------------------------------------------------------
# Purge a small number of users (< 100) with no progress bar.
#
    my $purge_type = lc scalar $IN->param('purge_type');
    my $purge_days = scalar $IN->param('purge_days');

    if ($purge_type ne 'inactive' and $purge_type ne 'expired') {
        return (FAILURE, { error => "Invalid purge type" });
    }

    unless ($purge_days) {
        return (FAILURE, { error => "Unable to purge users, as purge_days is set to 0 (which would erase the entire database)." });
    }
    $purge_days = time - $purge_days * 24 * 60 * 60;

    my $cond;
    my $users = $DB->table('users');
    if ($purge_type eq 'inactive') {
        $cond = new GT::SQL::Condition([users_last_login => '<' => $purge_days], [email => '<>' => ADMIN]);
    }
    else {
        $cond = new GT::SQL::Condition([users_payment_expiry => '<' => $purge_days], [users_payment_expiry => '>' => 0], [email => '<>' => ADMIN]);
    }
    my $cnt = $users->count($cond);
    $cnt or return (FAILURE, { error => 'No users to delete' });

# demo
#   return(SUCCESS, { del_num => $cnt, message => "Disabled in demo" });
#
    $users->delete($cond);

    return (SUCCESS, { del_num => $cnt, message => "$cnt users have been purged" });
}

sub users_calc {
# -------------------------------------------------------------------
# Figure out how many users will be purged, used to display a search
# link.
#
    my $purge_type = lc scalar $IN->param('purge_type');
    my $purge_days = scalar $IN->param('purge_days');

    if ($purge_type ne 'inactive' and $purge_type ne 'expired') {
        return (FAILURE, { error => "Invalid purge type" });
    }

    unless ($purge_days) {
        return (FAILURE, { error => "Unable to purge users, as purge_days is set to 0 (which would erase the entire database)." });
    }
    $purge_days = time - $purge_days * 24 * 60 * 60;

    my $cnt;
    my $users = $DB->table('users');
    if ($purge_type eq 'inactive') {
        $cnt = $users->count(GT::SQL::Condition->new([users_last_login => '<' => $purge_days], [email => '<>' => ADMIN]));
    }
    else {
        $cnt = $users->count(GT::SQL::Condition->new([users_payment_expiry => '<' => $purge_days], [users_payment_expiry => '>' => 0], [email => '<>' => ADMIN]));
    }
    $cnt or return (FAILURE, { message => 'No users to delete' });

    return (SUCCESS, {
        purge_days => scalar $IN->param('purge_days'),
        purge_date => $IN->escape(scalar(localtime($purge_days))),
        purge_type => $purge_type,
        del_num    => $cnt
    });
}

sub users_purge_progress {
# -------------------------------------------------------------------
# Purge using a Javascript progress bar.
#
    $| = 1;
    my $purge_type = lc scalar $IN->param('purge_type');
    my $purge_days = scalar $IN->param('purge_days');

    if ($purge_type ne 'inactive' and $purge_type ne 'expired') {
        return (FAILURE, { error => "Invalid purge type" });
    }

    unless ($purge_days) {
        return (FAILURE, { error => "Unable to purge users, as purge_days is set to 0 (which would erase the entire database)." });
    }
    $purge_days = time - $purge_days * 24 * 60 * 60;

    my $cond;
    my $users = $DB->table('users');
    if ($purge_type eq 'inactive') {
        $cond = new GT::SQL::Condition([users_last_login => '<' => $purge_days], [email => '<>' => ADMIN]);
    }
    else {
        $cond = new GT::SQL::Condition([users_payment_expiry => '<' => $purge_days], [users_payment_expiry => '>' => 0], [email => '<>' => ADMIN]);
    }
    my $sth = $users->select(['userid', 'email'], $cond);

    print $IN->header;
    my $total = $sth->rows;
    print qq|
<html>
<head>
<script language=JavaScript>
|;
    print "    var current = 'Deleting $total users';\n    var total = ", $sth->rows, ";\n    var count = 0;\n    var finished = false;\n";
    print qq|
</script>
<body bgcolor=#FFFFFF>
|;
    my $cnt = 0;

# demo 7
#   print qq|<script>alert("Disabled in demo");</script>|;
#
    while (my ($id, $user) = $sth->fetchrow) {
        $cnt++;
        print "<script>\ncurrent = 'Deleting $cnt/$total';\ncount++;\n</script>\n";
        unless ($users->delete({ userid => $id })) {
            print '<script>alert("Error deleting user: ', $user, '; Reason: ', $GT::SQL::error, '");</script>';
        }
    }

    print qq|
<script language="JavaScript">
finished = true;
count = total;
current = "Finished";
setTimeout("top.window.close()", 3000);
</script>
</body>
</html>
|;
    return (HANDLED);
}

sub msgs_purge {
# -------------------------------------------------------------------
# Purge a small number of messages.
#
    my $url = $IN->param('purge_url');
    $IN     = GT::CGI->new($url);
    my $cgi = $IN->get_hash;

    delete $cgi->{msgtrack_id};
    $cgi->{so} = ($cgi->{so} and $cgi->{so} =~ /(asc|desc)/i) ? $1 : 'asc';
    $cgi->{sb} ||= 'msgs_sent';
    $cgi->{mh} = -1;
    my ($tb, $cond) = _build_query_cond($cgi) or return;
# Get a preliminary list of msgtrack_id's:
    my @msgtrack_ids = $tb->select(msgtrack_id => $cond)->fetchall_list;

    my %folder_ids;
# If a folders_type was passed in, we have to select only messages from that folder.
    if (my $ftype = $cgi->{folders_type}) {
        my $sth = $DB->table('msgtrack', 'folders')->select(msgtrack_id => folders_id => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            folders_type => $ftype,
            msgtrack_id => \@msgtrack_ids
        });
        @msgtrack_ids = ();
        while (my ($mid, $fid) = $sth->fetchrow) {
            push @msgtrack_ids, $mid;
            $folder_ids{$fid}++;
        }
    }
    else {
        my @folders = $DB->table('msgtrack', 'folders')->select(folders_id => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            msgtrack_id => \@msgtrack_ids
        })->fetchall_list;
        for (@folders) { $folder_ids{$_}++ }
    }

    @msgtrack_ids or return (FAILURE, { error => 'No messages to delete' });

# demo
#   return(SUCCESS, { del_num => scalar(@msgtrack_ids), message => "Disabled in demo" });
#
    my $cnt = 0 + $tb->delete({ msgtrack_id => \@msgtrack_ids });

# Update any folder counts:
    my $fmm = $DB->table(qw/folders msgtrack msgs/);
    $fmm->select_options('GROUP BY folders_id, msgtrack_status');
    my $sth = $fmm->select(
        qw/folders_id COUNT(*) SUM(msgs_size) msgtrack_status/ => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            folders_id => [keys %folder_ids]
        }
    );
    my $folders = $DB->table('folders');
    my ($last_folder, $total, $unread, $total_size) = (0, 0, 0, 0);
    while (my ($folders_id, $count, $size, $status) = $sth->fetchrow) {
        if ($folders_id != $last_folder and $last_folder) {
            delete $folder_ids{$last_folder};
            $folders->update({
                folders_total => $total,
                folders_unread => $unread,
                folders_size => $total_size
            }, { folders_id => $last_folder });
        }
        elsif (!$last_folder) {
            ($last_folder, $total, $unread, $total_size) = ($folders_id, 0, 0, 0);
        }
        $total += $count;
        $unread += $count if $status eq 'New' or substr($status, 0, 5) eq 'Draft';
        $total_size += $size;
    }
    if ($last_folder) {
        delete $folder_ids{$last_folder};
        $folders->update({
            folders_total => $total,
            folders_unread => $unread,
            folders_size => $total_size
        }, { folders_id => $last_folder });
    }

# Anything left is empty:
    $folders->update(
        {
            folders_total => 0,
            folders_unread => 0,
            folders_size => 0
        }, {
            folders_id => [keys %folder_ids]
        }
    ) if keys %folder_ids;

    return(SUCCESS, { del_num => $cnt, message => "$cnt messages have been purged" });
}

sub msgs_calc {
# -------------------------------------------------------------------
# Figure out how many messages to purge.
#
    $IN->delete('do');
    $IN->delete('action');

    my $purge_days = scalar $IN->delete('purge_days');
    if ($purge_days) {
        require GT::Date;
        $IN->param(msgs_sent => GT::Date::date_get(time - $purge_days * 24 * 60 * 60, "%ddd% %mmm% %d% %H%:%M%:%s% %yyyy%"));
        $IN->param('msgs_sent-opt' => '<');
    }

    my $cgi = $IN->get_hash;

    delete $cgi->{msgtrack_id};
    $cgi->{so} = ($cgi->{so} and $cgi->{so} =~ /(asc|desc)/i) ? $1 : 'asc';
    $cgi->{sb} ||= 'msgs_sent';
    $cgi->{mh} = -1;
    my ($tb, $cond) = _build_query_cond($cgi) or return;

# Get a preliminary list of msgtrack_id's:
    my @msgtrack_ids = $tb->select(msgtrack_id => $cond)->fetchall_list;

# If a folders_type was passed in, we have to select only messages from that folder.
    if (my $ftype = $cgi->{folders_type}) {
        @msgtrack_ids = $DB->table('msgtrack', 'folders')->select(msgtrack_id => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            folders_type => $ftype,
            msgtrack_id => \@msgtrack_ids
        })->fetchall_list;
    }

    @msgtrack_ids or return (FAILURE, { error => 'No messages to delete' });

    return(SUCCESS, { purge_url => $IN->escape($IN->query_string), del_num => scalar @msgtrack_ids });
}

sub msgs_purge_progress {
# -------------------------------------------------------------------
# Javascript progress bar for a purging a large number of messages.
#
    $| = 1;
    my $purge_days = scalar $IN->delete('purge_days');
    if ($purge_days) {
        require GT::Date;
        $IN->param(msgs_sent => GT::Date::date_get(time - $purge_days * 24 * 60 * 60, "%ddd% %mmm% %d% %H%:%M%:%s% %yyyy%"));
        $IN->param('msgs_sent-opt' => '<');
    }

    my $cgi = $IN->get_hash;

    delete $cgi->{msgtrack_id};
    $cgi->{so} = ($cgi->{so} and $cgi->{so} =~ /(asc|desc)/i) ? $1 : 'asc';
    $cgi->{sb} ||= 'msgs_sent';
    $cgi->{mh} = -1;
    my ($tb, $cond) = _build_query_cond($cgi) or return;
# Get a preliminary list of msgtrack_id's:
    my @msgtrack_ids = $tb->select(msgtrack_id => $cond)->fetchall_list;

    my %folder_ids;
# If a folders_type was passed in, we have to select only messages from that folder.
    if (my $ftype = $cgi->{folders_type}) {
        my $sth = $DB->table('msgtrack', 'folders')->select(msgtrack_id => folders_id => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            folders_type => $ftype,
            msgtrack_id => \@msgtrack_ids
        });
        @msgtrack_ids = ();
        while (my ($mid, $fid) = $sth->fetchrow) {
            push @msgtrack_ids, $mid;
            $folder_ids{$fid}++;
        }
    }
    else {
        my @folders = $DB->table('msgtrack', 'folders')->select(folders_id => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            msgtrack_id => \@msgtrack_ids
        })->fetchall_list;
        for (@folders) { $folder_ids{$_}++ }
    }

    my $sth = $tb->select('msgtrack_id', 'msgtrack_userid', { msgtrack_id => \@msgtrack_ids });
    local($SIG{__DIE__}) = sub { $CFG->{enabled} = 1; $CFG->save };
    $CFG->{enabled} = 0;
    $CFG->save;
    print $IN->header;
    my $total = $sth->rows;
    print qq|
<html>
<head>
<script language=JavaScript>
|;
    print "    var current = 'Deleting $total messages';\n    var total = $total;\n    var count = 0;\n    var finished = false;\n";
    print qq|
</script>
<body bgcolor=#FFFFFF>
|;
    my $cnt = 0;
    my $msgt = $DB->table('msgtrack');

# demo 7
#   print qq|<script>alert("Disabled in demo");</script>|;
#
    while (my ($id, $user) = $sth->fetchrow) {
        $cnt++;
        print "<script>\ncurrent = 'Deleting $cnt/$total';\ncount++;\n</script>\n";
        if (!$msgt->delete({ msgtrack_id => $id }, 'cleanup')) {
            print '<script>alert("Error deleting message for userid: ', $user, '; Reason: ', $GT::SQL::error, '");</script>';
        }
    }

    print "<script>\ncurrent = 'Updating folder counts...';\n</script>\n";
# Update any folder counts:
    my $fmm = $DB->table(qw/folders msgtrack msgs/);
    $fmm->select_options('GROUP BY folders_id, msgtrack_status');
    $sth = $fmm->select(
        qw/folders_id COUNT(*) SUM(msgs_size) msgtrack_status/ => {
            msgtrack_fid => \'folders_fid',
            msgtrack_userid => \'folders_userid',
            folders_id => [keys %folder_ids]
        }
    );
    my $folders = $DB->table('folders');
    my ($last_folder, $total_count, $unread, $total_size) = (0, 0, 0, 0);
    while (my ($folders_id, $count, $size, $status) = $sth->fetchrow) {
        if ($folders_id != $last_folder and $last_folder) {
            delete $folder_ids{$last_folder};
            $folders->update({
                folders_total => $total_count,
                folders_unread => $unread,
                folders_size => $total_size
            }, { folders_id => $last_folder });
        }
        elsif (!$last_folder) {
            ($last_folder, $total_count, $unread, $total_size) = ($folders_id, 0, 0, 0);
        }
        $total_count += $count;
        $unread += $count if $status eq 'New' or substr($status, 0, 5) eq 'Draft';
        $total_size += $size;
    }
    if ($last_folder) {
        delete $folder_ids{$last_folder};
        $folders->update({
            folders_total => $total_count,
            folders_unread => $unread,
            folders_size => $total_size
        }, { folders_id => $last_folder });
    }

# Anything left is empty:
    $folders->update(
        {
            folders_total => 0,
            folders_unread => 0,
            folders_size => 0
        }, {
            folders_id => [keys %folder_ids]
        }
    ) if keys %folder_ids;

    print qq|
<script language="JavaScript">
finished = true;
count = total;
current = "Finished";
setTimeout("top.window.close()", 3000);
</script>
</body>
</html>
|;
    $CFG->{enabled} = 1;
    $CFG->save;
    return(HANDLED);
}

sub _build_query_cond {
# -------------------------------------------------------------------
# Converts form input into a cgi hash.
#
    my ($in) = @_;
    $GT::SQL::PREFIX ||= '';

# Must make a top level copy
    my $cgi = {};
    for (keys %{$in}) { $cgi->{$_} = $in->{$_} }

# We override the query functionality here
    my $q;
    if ($cgi->{query} and ($cgi->{query} =~ /\S/)) {
        $q = delete $cgi->{query};
    }
    my $match = 0;
    for (keys %{$cgi}) {
        if (/msgsearch/ and defined($cgi->{$_}) and $cgi->{$_} =~ /\S/) {
            $match = 1;
            last;
        }
    }
    my ($tb, @tables);

# If we are doing a query on the body of messages, we need the msgsearch table
# in our join.
    if ($match or $q or ($cgi->{keyword} and $cgi->{keyword} =~ /\S/)) {
        $tb = $DB->table('msgtrack', 'msgs', 'msgsearch');
        @tables = ($DB->table('msgtrack'), $DB->table('msgs'), $DB->table('msgsearch'));
    }
    else {
        $tb = $DB->table('msgtrack', 'msgs');
        @tables = ($DB->table('msgtrack'), $DB->table('msgs'));
    }

# Get a list of the columns with the table name prepended
    my $cols = $tb->cols;

# Add any options they specified for the search
    my $opts = {};
    for (qw/mh nh ma so sb ww/) {
        $opts->{$_} = $cgi->{$_} if defined($cgi->{$_}) and $cgi->{$_} =~ /\S/;
    }
    if ($cgi->{so} and $cgi->{sb}) {
        $cgi->{sb} = "ORDER BY " . $cgi->{sb} . " " . $cgi->{so};
    }
    else {
        delete $cgi->{sb};
    }
    $cgi->{mh} ||= -1;
    $cgi->{nh} ||= 1;
    my $offset   = ($cgi->{nh} -1) * $cgi->{mh};
    $tb->select_options ($cgi->{sb} || '', $cgi->{mh} == -1 ? () : "LIMIT $offset, $cgi->{mh}");

# Add any columns used for the search. userid is NOT allowed in the search for
# obvious reasons.
    my @times;
    for (keys %{$cols}) {
        next if /userid/;
        (my $cp = $_) =~ s/^[^.]+\.//;
        $opts->{"$_-opt"} = $cgi->{"$cp-opt"} if exists $cgi->{"$cp-opt"} and $cgi->{"$cp-opt"} =~ /\S/;
        if ($cgi->{$cp} and $cp eq 'msgs_sent') {
            @times = date_to_time($cgi->{$cp});
            next;
        }
        $opts->{$_} = $cgi->{$cp} if exists $cgi->{$cp} and $cgi->{$cp} =~ /\S/;
    }

    my $time_cond;
    if (@times) {
        if (@times == 1 or $opts->{$GT::SQL::PREFIX . 'msgs.msgs_sent-opt'} ne '=') {
            $opts->{$GT::SQL::PREFIX . 'msgs.msgs_sent'} = $times[0];
        }
        else {
            my ($start, $stop) = @times;
            $time_cond = new GT::SQL::Condition(
                [msgs_sent => '<' => $stop],
                [msgs_sent => '>' => $start]
            );
        }
    }

# Build the condition
    my $user_cond = $tb->build_query_cond($opts, $cols);

# Add the query to the condition if needed
    if ($q) {
        $user_cond ||= GT::SQL::Condition->new;
        my $cond1 = GT::SQL::Condition->new(
            [$GT::SQL::PREFIX . 'msgsearch.msgsearch_body', 'LIKE', "%$q%"],
            [$GT::SQL::PREFIX . 'msgsearch.msgsearch_header', 'LIKE', "%$q%"]
        );
        $cond1->bool('OR');
        $user_cond->add($cond1);
    }

# We have to search on the userid with no LIKE
    my $cond;
    if ($user_cond) {
        $user_cond->bool($cgi->{ma} || 'AND');
        if ($time_cond) {
            $user_cond->add($time_cond);
        }
        $cond = $user_cond;
    }
    else {
        if ($time_cond) {
            $cond = $time_cond;
        }
        else {
            $cond = GT::SQL::Condition->new;
        }
    }

    return ($tb, $cond);
}

sub date_to_time {
# -------------------------------------------------------------------
# Converts a date to a time, but fatals if it can't convert as we don't
# want to mess up a purge.
#
    my $date = shift;
    my $lt;
    my @localtime;
    require GT::Date;
    DATE: {
        (uc $date eq 'NOW') and (@localtime = localtime), last DATE;
# localtime format
        $date =~ m|^\w+ \w{3} \d{1,2} \d{1,2}:\d{1,2}:\d{1,2} \d{4}$|  and (@localtime = @{GT::Date::_parse_format($date, '%ddd% %mmm% %d% %H%:%M%:%s% %yyyy%')}), last DATE;
        $date =~ m|^\w+ \w{3}  \d{1,2} \d{1,2}:\d{1,2}:\d{1,2} \d{4}$| and (@localtime = @{GT::Date::_parse_format($date, '%ddd% %mmm%  %d% %H%:%M%:%s% %yyyy%')}), last DATE;

# Okay, it wasn't simply them modifying what was displayed, so let's try some other common formats:
# just the date, no time:
        # yyyy/mm/dd
        $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2}$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d%")});

# If we match here we need to do a range
        my $start_time   = GT::Date::timelocal(@localtime);
        my $end_time     = $start_time + 60*60*24 - 1;
        return(GT::Date::date_get($start_time, '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%'), GT::Date::date_get($end_time, '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%'));

# 12 hour time:
# yyyy/mm/dd hh:MM [AP]M
        $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}[Hh:]\d{1,2} [AaPp][Mm]$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %h%:%M% %tt%")}), last DATE;
# yyyy/mm/dd hh:MM:ss [AP]M
        $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}:\d{1,2} [AaPp][Mm]$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %h%:%M%:%s% %tt%")}), last DATE;

# 24 hour time:
# yyyy/mm/dd HH:MM
        $date =~ m|^\d{4}([-/])\d{1,2}([-/Hh])\d{1,2} \d{1,2}[Hh:]\d{1,2}$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %H%:%M%")}), last DATE;
# yyyy/mm/dd HH:MM:ss
        $date =~ m|^\d{4}([-/])\d{1,2}([-/])\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}$| and (@localtime = @{GT::Date::_parse_format($date, "%yyyy%$1%m%$2%d% %H%:%M%:%s%")}), last DATE;
# Common formats that can't be recognized:
# dd/mm/yyyy - These two are conflicting US/European formats and so it would
# mm/dd/yyyy - be impossible to figure out which one you are trying to use.
    }
    if (! @localtime) {
        die "Unable to convert date '$date' into a unix timestamp, please check the format of your date.";
    }

    return scalar @localtime ? GT::Date::date_get(GT::Date::timelocal(@localtime), '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%') : '';
}

END {
    $CFG->{enabled} = 1;
    $CFG->save;
}


1;