#!/usr/bin/perl -T -w
#
# $Id: mbox-prune,v 1.6 2008/05/17 07:00:42 suter Exp $
# Copyright (C) 2003 Mark Suter <suter@humbug.org.au>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# [MJS 24 Sep 2002] Initial version to prune older messages from a mbox.

use strict;
use Getopt::Long;
use Pod::Usage;
use Mail::Box::Manager;

# Process the options
$ENV{'PATH'} = '/bin:/usr/bin';
my %opt = (man => 0, help => 0, days => undef, verbose => 0);
GetOptions(\%opt, "man", "help", "days=i", "verbose") or pod2usage(0);
$opt{man} and pod2usage(-exitval => 0, -verbose => 2);
$opt{help} and pod2usage(0);
defined($opt{days}) or pod2usage(0);
scalar @ARGV >= 1 or pod2usage(0);

$|++; # autoflush

# Loop over each file (untainting and checking before we start doing anything)
foreach my $file (map { /(.+)/ and -f $1 and -r _ or die "mbox-prune: File $1 not readable!\n"; $1 } @ARGV) {

    # Take note of permissions and ownership
    my $mode = (stat _)[2];
    my $uid = (stat _)[4];
    my $gid = (stat _)[5];

    # Build a "mailbox" from standard input
    $opt{verbose} and print "Opening $file with ", -s _, " bytes ";
    my $mgr = Mail::Box::Manager->new or die "$0: Can't initialise Mail::Box::Manager: $!\n";
    my $folder = $mgr->open(folder => $file, extract => 'LAZY', keep_dups => 1, access => 'rw');

    $opt{verbose} and my $count = $folder->messages;
    $opt{verbose} and print "$count messages ";
    $opt{verbose} and my $marker = 1 + int $count / 20;

    # Iterate over each message, marking messages older we want
    my $threshold = time() - $opt{days} * (60*60*24);
    my $i = 0;
    foreach ($folder->messages) {
	$opt{verbose} and 0 == $i++ % $marker and print ".";
	$_->timestamp < $threshold and $_->delete();
    }

    # Close the folder, deleting the emails marked for deletion
    $opt{verbose} and print " closing $file ";
    $folder->close();
    $opt{verbose} and print -e $file ? "with " . (-s _) . " bytes.\n" : "and removing it.\n";

    # Restore permissions and ownership
    chown $uid, $gid, $file;
    chmod $mode, $file;

}

__END__

=head1 NAME

mbox-prune

=head1 SYNOPSIS

mbox-prune --days XX file...

=head1 OPTIONS

=over 8

=item B<--days>=B<number>

Emails older than this many days will be pruned.

=item B<--man>

Print the manual page and exit.

=item B<--help>

Print a brief help message and exit.

=item B<--verbose>

Explain what is being done.  This output should cleanly indicate
progress; however, errors and irregularities in the emails may
produce errors.

=back

=head1 DESCRIPTION

B<This program> will remove emails older than the specified
number of days from the mbox files given on the command line.

=head1 EXAMPLE

A simple cleaning of a spam folder:

    mbox-prune --verbose --days 15 ~/mail/spam

For the adventurous on a small system (wildcards expansion limitations):

    mbox-prune --verbose --days 30 /var/mail/*

To prune a "spam" folder in each users home directory:

   find /home -maxdepth 2 -type f -name spam -print0 | xargs -0 -r mbox-prune --verbose --days 30

=head1 EXIT CODES

If B<this program> exits with a zero exit status and the correct
output is on standard output.  Nothing else should be printed to
standard output.

B<This program> will exit with a non-zero exit status if there
was a fatal error.  Both fatal and non-fatal errors will cause
output on standard error.

=head1 AUTHOR

Mark Suter E<lt>F<suter@humbug.org.au>E<gt>

=head1 COPYRIGHT

Copyright (C) 2003 Mark Suter E<lt>F<suter@humbug.org.au>E<gt>

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA or from the following webpage.

    http://www.gnu.org/licenses/gpl.txt

=cut