# ================================================================== # Gossamer Mail - enhanced email management system # # Website : http://gossamer-threads.com/ # Support : http://gossamer-threads.com/scripts/support/ # CVS Info : # Revision : $Id: Purge.pm,v 1.10 2001/09/19 23:04:51 sbeck 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_days = $IN->param('purge_days'); if (! $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 $tb = $DB->table('users'); my $cond = new GT::SQL::Condition([users_last_login => '<' => $purge_days], [email => '<>' => ADMIN]); my $cnt = $tb->count($cond); $cnt or return (FAILURE, { error => 'No users to delete' }); $DB->table('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_days = $IN->param('purge_days'); $purge_days = time - $purge_days * 24 * 60 * 60; my $cnt = $DB->table('users')->count(GT::SQL::Condition->new([users_last_login => '<' => $purge_days], [email => '<>' => ADMIN])); $cnt or return (FAILURE, { message => 'No users to delete' }); return(SUCCESS, { purge_days => $purge_days, purge_date => $IN->escape(scalar(localtime($purge_days))), del_num => $cnt }); } sub users_purge_progress { # ------------------------------------------------------------------- # Purge using a Javascript progress bar. # $| = 1; my $purge_days = $IN->param('purge_days'); if (! $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 $tb = $DB->table('users'); my $sth = $tb->select(['userid', 'email'], GT::SQL::Condition->new([users_last_login => '<' => $purge_days], [email => '<>' => ADMIN])); local($SIG{__DIE__}) = sub { $CFG->{enabled} = 1; $CFG->save_config }; $CFG->{enabled} = 0; $CFG->save_config; print $IN->header; my $total = $sth->rows; print qq| |; my $cnt = 0; while (my ($id, $user) = $sth->fetchrow) { $cnt++; print "\n"; if (!$tb->delete({userid => $id})) { print ''; } } print qq| |; $CFG->{enabled} = 1; $CFG->save_config; 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} and ($cgi->{so} =~ /((?:asc)|(?:desc))/i)) ? ($cgi->{so} = $1) : ($cgi->{so} = 'asc'); $cgi->{sb} ||= 'msgs_sent'; my ($tb, $cond) = _build_query_cond($cgi) or return; my $cnt = $tb->count($cond); $cnt or return (FAILURE, { error => 'No messages to delete' }); $tb->delete($cond); 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 $cgi = $IN->get_hash; delete $cgi->{msgtrack_id}; ($cgi->{so} and ($cgi->{so} =~ /((?:asc)|(?:desc))/i)) ? ($cgi->{so} = $1) : ($cgi->{so} = 'asc'); $cgi->{sb} ||= 'msgs_sent'; $cgi->{mh} = -1; my ($tb, $cond) = _build_query_cond($cgi) or return; my $cnt = $tb->count($cond); $cnt or return (FAILURE, { message => 'No messages to delete' }); return(SUCCESS, { purge_url => $IN->escape($IN->query_string), del_num => $cnt }); } sub msgs_purge_progress { # ------------------------------------------------------------------- # Javascript progress bar for a purging a large number of messages. # $| = 1; my $cgi = $IN->get_hash; delete $cgi->{msgtrack_id}; ($cgi->{so} and ($cgi->{so} =~ /((?:asc)|(?:desc))/i)) ? ($cgi->{so} = $1) : ($cgi->{so} = 'asc'); $cgi->{sb} ||= 'msgs_sent'; $cgi->{mh} = -1; my ($tb, $cond) = _build_query_cond($cgi) or return; my $sth = $tb->select(['msgtrack_id', 'msgtrack_userid'], $cond); local($SIG{__DIE__}) = sub { $CFG->{enabled} = 1; $CFG->save_config }; $CFG->{enabled} = 0; $CFG->save_config; print $IN->header; my $total = $sth->rows; print qq| |; my $cnt = 0; my $msgt = $DB->table('msgtrack'); while (my ($id, $user) = $sth->fetchrow) { $cnt++; print "\n"; if (!$msgt->delete({ msgtrack_id => $id }, 'cleanup')) { print ''; } } print qq| |; $CFG->{enabled} = 1; $CFG->save_config; 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_config; } 1;