Как я могу загрузить почтовые вложения IMAP по SSL и сохранить их локально использование Perl?
Мне нужны предложения о том, как я могу загрузить вложения со своих писем IMAP, которые имеют вложения и текущую дату в строке темы т.е. YYYYMMDD формат и сохраняет вложения к локальному пути.
Я прошел Почту модуля Perl:: IMAPClient и может соединиться с почтовым сервером IMAP, но нуждаться в помощи на других задачах. Еще одна вещь отметить состоит в том, что мой IMAP разъединяет, требует автора SSL.
Также вложения могли быть gz, tar или tar.gz файлами.
2 ответа
Простая программа, которая делает то, что вы хотите, приведена ниже.
#! /usr/bin/perl
use warnings;
use strict;
Минимальная версия для Email::MIME на момент появления walk_parts.
use Email::MIME 1.901;
use IO::Socket::SSL;
use Mail::IMAPClient;
use POSIX qw/ strftime /;
use Term::ReadKey;
Вы же не хотите жестко кодировать свой пароль в программе?
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;
}
Подключение с использованием SSL. Мы должны были бы уметь делать это с помощью простого Ssl параметра конструктора, но некоторые производители решили сломать его в своих пакетах.
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 $@;
Если вам нужна папка, отличная от папки входящих сообщений, измените ее.
$imap->select("INBOX")
or die "$0: select INBOX: ", $imap->LastError, "\n";
Используя поиск IMAP, мы ищем все сообщения, темы которых содержат сегодняшнюю дату в формате YYYYMMDD. Дата может находиться в любом месте темы, поэтому, например, тема "foo bar baz 2010316" будет соответствовать сегодняшнему дню.
my $today = strftime "%Y%m%d", localtime $^T;
my @messages = $imap->search(SUBJECT => $today);
die "$0: search: $@" if defined $@;
Для каждого такого сообщения запишите его вложения в файлы в текущем каталоге. Мы записываем самый внешний слой вложений и не копаемся во вложенных вложениях. Часть с параметром name в типе содержимого (как в image/jpeg; name="foo.jpg") считается вложением, и мы игнорируем все остальные части. Имя сохраненного вложения состоит из следующих компонентов, разделенных -: сегодняшняя дата, идентификатор сообщения IMAP, одноосный индекс его позиции в сообщении и его имя.
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=([^"]+)/
or $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: $!";
});
}
Если вы хотите использовать Mail::IMAPClient, вы можете указать ему использовать SSL.
Альтернативно, Net::IMAP::Simple::SSL также может помочь вам в этом. Интерфейс такой же, как и у Net::IMAP::Simple.
После того как вы получили сообщение, Parsing emails with attachments показывает, как извлечь вложения. Я не пробовал, но мне кажется, что использование Email::MIME::walk_parts может значительно упростить сценарий, показанный в статье PerlMonks.