#!/usr/bin/perl
use HTTP::Date;
use Getopt::Long;
use Mail::Box::Manager;
use Pod::Usage;
use strict;
use warnings;

use constant ONE_DAY => 86400;
my $days = 7;
my $filename = '';
my $help = '';
my $verbose = 1;

Getopt::Long::Configure('gnu_getopt');
GetOptions (
  'days|d=i' => \$days,
  'folder|f=s' => \$filename,
  'help|h|?' => \$help,
  'verbose!' => \$verbose,
) or pod2usage(-exitstatus => 2, -verbose => 1);
pod2usage(-exitstatus => 0, -verbose => 2) if $help;
die "You must specify a folder\n" unless $filename;
my $expire = time - ($days * ONE_DAY);
my $mgr    = Mail::Box::Manager->new;
my $folder = $mgr->open
   ( $filename,
     access => 'rw',
     extract => 'LAZY', # To save memory & time, don't parse body unle
+ss needed.
     log => 'ERRORS',   # Don't log or trace warnings.
     trace => 'ERRORS',
   );
die "Cannot open $filename: $!\n" unless defined $folder;
my @messages = $folder->messages;
my $count = 0;
foreach my $message (@messages)
{
  ++$count;
  print 'Processing message ', $count, "\n"
    if $verbose && ($count % 100 == 0);
  my $date = str2time($message->date);
  $message->delete unless $date > $expire;
}
$folder->close (write => 'MODIFIED');

0;

__END__

=head1 NAME

mailexpire - Delete old mail from folders.

=head1 SYNOPSIS

mailexpire [options]

=head1 DESCRIPTION

B<mailexpire> deletes mail older than a certain number of days from a 
+folder.

=head1 OPTIONS

=over 8

=item B<--days|-d> I<number_of_days>

Any mail older than this number of days will be deleted from the folde
+r.  If
this option is not specified, the default number of days is 7.

=item B<--folder|-f> I</path/to/folder>

The location of the folder to operate on.  This option is mandatory.  
+The
folder can be of any type supported by L<Mail::Box>

=item B<--help|-h|-?>

Display the documentation.

=item B<--noverbose>

Surpresses the progress information.  This is useful if e.g. you are r
+unning
the script from a cron job.

=back

=head1 BUGS

The script is exceedingly slow on large folders which take up more
physical memory than you've got.  A folders' memory consumption seems 
+to
be about 5 times the size of the file on disk so it is easy to be forc
+ed into
swap and thrash if your folder is big.  The answer is probably not use
+ a pure
perl module like L<Mail::Box>.

=head1  SEE ALSO

L<Mail::Box-Overview>, L<perl>

=head1 AUTHOR

Jaldhar H. Vyas E<lt>jaldhar@braincells.comE<gt>

=head1 LICENSE

This code is free software under the Crowley Public License ("Do what
thou wilt shall be the whole of the license")

=head1 VERSION

1.1 -- Feb 24, 2003

=cut