A simple program that does what you want is below.
#! /usr/bin/perl
use warnings;
use strict;
The minimum version for Email::MIME
is for when walk_parts
was introduced.
use Email::MIME 1.901;
use IO::Socket::SSL;
use Mail::IMAPClient;
use POSIX qw/ strftime /;
use Term::ReadKey;
You don't want to hardcode your password in your program, do you?
sub read_password {
local $| = 1;
print "Enter password: ";
ReadMode "noecho";
my $password = <STDIN>;
ReadMode "restore";
die "$0: unexpected end of input"
unless defined $password;
print "\n";
chomp $password;
$password;
}
Connect using SSL. We ought to be able to be able to do this with a simple Ssl
parameter to the constructor, but some vendors have chosen to break it in their packages.
my $pw = read_password;
my $imap = Mail::IMAPClient->new(
#Debug => 1,
User => "you\@domain.com",
Password => $pw,
Uid => 1,
Peek => 1, # don't set \Seen flag
Socket => IO::Socket::SSL->new(
Proto => 'tcp',
PeerAddr => 'imap.domain.com',
PeerPort => 993,
),
);
die "$0: connect: $@" if defined $@;
If you want a folder other than the inbox, change it.
$imap->select("INBOX")
or die "$0: select INBOX: ", $imap->LastError, "\n";
Using IMAP search, we look for all messages whose subjects contain today's date in YYYYMMDD format. The date can be anywhere in the subject, so, for example, a subject of "foo bar baz 20100316" would match today.
my $today = strftime "%Y%m%d", localtime $^T;
my @messages = $imap->search(SUBJECT => $today);
die "$0: search: $@" if defined $@;
For each such message, write its attachments to files in the current directory. We write the outermost layer of attachments and do not dig for nested attachments. A part with a name parameter in its content type (as in image/jpeg; name="foo.jpg"
) is assumed to be an attachment, and we ignore all other parts. A saved attachment's name is the following components separated by -
: today's date, its IMAP message ID, a one-based index of its position in the message, and its name.
foreach my $id (@messages) {
die "$0: funky ID ($id)" unless $id =~ /\A\d+\z/;
my $str = $imap->message_string($id)
or die "$0: message_string: $@";
my $n = 1;
Email::MIME->new($str)->walk_parts(sub {
my($part) = @_;
return unless $part->content_type =~ /\bname="([^"]+)"/; # " grr...
my $name = "./$today-$id-" . $n++ . "-$1";
print "$0: writing $name...\n";
open my $fh, ">", $name
or die "$0: open $name: $!";
print $fh $part->content_type =~ m!^text/!
? $part->body_str
: $part->body
or die "$0: print $name: $!";
close $fh
or warn "$0: close $name: $!";
});
}