package Email::Delete::Mbox;
# $Id: Mbox.pm,v 1.3 2004/12/17 18:45:50 cwest Exp $
use strict;
{
package Email::LocalDelivery::OverwriteMbox;
use base qw[Email::LocalDelivery::Mbox];
my $fh;
sub _set_fh { $fh = $_[1] }
sub _open_fh { $fh }
sub _close_fh { 1 }
}
package Email::Delete::Mbox;
use base qw[Email::Folder::Mbox];
use vars qw[$VERSION];
$VERSION = sprintf "%d.%02d", split m/\./, (qw$Revision: 1.3 $)[1];
use Email::Folder;
use IO::File;
sub delete_message {
my %args = @_;
my $fh = IO::File->new($args{from}, '+<');
flock $fh, 2;
{
local $^W = 0;
*_get_fh = sub { $fh };
}
my $folder = Email::Folder->new(
$args{from},
reader => __PACKAGE__,
);
my (@keep, @delete);
while ( my $message = $folder->next_message ) {
my $trash_it = $args{matching}->($message);
if ( $trash_it ) {
push @delete, $message;
next;
}
push @keep, $message;
}
return 0 unless @delete;
seek $fh, 0, 0;
Email::LocalDelivery::OverwriteMbox->_set_fh($fh);
Email::LocalDelivery::OverwriteMbox->deliver($_->as_string, $fh)
for @keep;
Email::LocalDelivery::OverwriteMbox->_set_fh(undef);
truncate $fh, tell $fh;
close $fh;
return scalar @delete;
}
1;
__END__
=head1 NAME
Email::Delete::Maildir - Delete Messages from a mbox Folder
=head1 SYNOPSIS
use Email::Delete qw[delete_message];
my $message_id = shift @ARGV;
delete_messages from => 'some/mbox',
matching => sub {
my $message = shift;
$message->header('Message-ID') =~ $message_id;
};
=head1 DESCRIPTION
This software will delete messages from a given mbox folder.
You may be interested to know that every call to C<delete_message> will
lock properly (thus annoyingly) throughout the entire process of
scanning and rebuilding the mbox.
=head1 SEE ALSO
L<Email::Delete>,
L<perl>.
=head1 AUTHOR
Casey West, <F<casey@geeknest.com>>.
=head1 COPYRIGHT
Copyright (c) 2004 Casey West. All rights reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut