The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Email::Delete::Maildir;
# $Id: Maildir.pm,v 1.1 2004/12/17 18:03:16 cwest Exp $
use strict;

use vars qw[$VERSION];
$VERSION = '2.001';

use Email::Simple;

sub delete_message {
    my %args = @_;
    
    my @files;
# Whatever in F<tmp/> is undelivered yet, right?
    foreach my $sect ( qw( new cur ) ) {
# What if C<$args{from}> is something but directory?  Never mind, just skip it.
        opendir my($dh), "$args{from}/$sect" or next;
        while(my $mail = readdir $dh) {
# Faild to open subfolder?  Here?  Immaterial, go away.
            -f "$args{from}/$sect/$mail"                          or next;
            open my $fh, '<', "$args{from}/$sect/$mail"           or next;
            my $msg = Email::Simple->new(do { local $/; <$fh>; }) or next;
            $args{matching}->($msg) and push @files, "$args{from}/$sect/$mail";
        };
    };
    return unlink @files;
}

1;

__END__

=head1 NAME

Email::Delete::Maildir - Delete Messages from a Maildir Folder

=head1 SYNOPSIS

  use Email::Delete qw[delete_message];
  
  my $message_id = shift @ARGV;
  
  delete_messages from     => 'some/Maildir/',
                  matching => sub {
                      my $message = shift;
                      $message->header('Message-ID') =~ $message_id;
                  };

=head1 DESCRIPTION

This software will delete messages from a given Maildir folder.

=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