#!/usr/bin/perl -w
#
# $Id: mbox-archive,v 1.1 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 archive older messages from a mbox.

use strict;
use Getopt::Long;
use Pod::Usage;
use Mail::Box::Manager;
use POSIX qw(strftime);

# Process the options
$ENV{'PATH'} = '/bin:/usr/bin';
my %opt = (man => 0, help => 0, days => undef, prefix => "archive", verbose => 0);
GetOptions(\%opt, "man", "help", "days=i", "prefix=s", "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 mbox (untainting and checking before we start doing anything)
foreach my $file (map { /(.+)/ and -r _ or die "mbox-archive: $1 is not readable!\n"; $1 } @ARGV) {

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

    $opt{verbose} and my $count = scalar $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 
	    $mgr->moveMessage(strftime("$opt{prefix}-%Y-%m", localtime $_->timestamp), $_, create => 1);
    }

    # Close the folder, deleting the emails marked for deletion
    $opt{verbose} and print " closing $file\n";
    $folder->close();

}

__END__

=head1 NAME

mbox-archive

=head1 SYNOPSIS

mbox-archive --days XX file...

=head1 OPTIONS

=over 8

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

Emails older than this many days will be archived.

=item B<--prefix>=B<string>

This is taken as the prefix for the filenames created when the messages
are archived.  The strftime pattern "foobar-%Y-%m" will be used.

=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 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