парсим атачи в письме. Или немного о MIME::Base64

[Skif]

Столкнулся с проблемой на ActivePerl в работе одного из модулей в результате чего вынужден самомтоятельно парсить все заголовки и тело письма.
В принципе мне надо выдрать только аттач(аттачи) и все.

сваял несколько вариантов кода, вот два примера:
Первый

if ($size > 1) {

for (my $i = 1 ;$i <($size-1) ;$i++) {

print "============= part $i ==============\\n";

#print "$arr_message[$i]";

if ($arr_message[$i]=~m/filename=/gi) {

print "Exist FILENAME=";

my $line = $arr_message[$i];

 my $mail = Email::Simple->new($line);

 my $bod = $mail->body;

 $bod =~ s/\\n//gi;

 open (TMP,">e:\\\\scripts\\\\1c_exch\\\\tmp\\\\file.txt")|| die "Cannot open file!\\n";

print TMP $bod;

 close (TMP);

 open (OTMP,">e:\\\\scripts\\\\1c_exch\\\\tmp\\\\file.zip")|| die "Cannot open file!\\n";

print OTMP decode_base64($bod);

 close (OTMP);

}

print "====================================\\n";

}

}

Второй:

$r ="\\#";

$line =~ s/\\n/$r/g;

$line =~ tr#A-Za-z0-9.\\-\\=\\;\\"\\#\\\\\\/+/##cd;

$line =~ s/$r/\\n/g;

my $file ="filename=\\"";

my $end ="\\"";

my @arr = split(/\\n\\n/,$line);

my $att_head = $arr[0];

my $att_file = $arr[1];

$att_file =~ s/\\n//g;

$att_file =~ tr#A-Za-z0-9+/##cd;

my @arr_file_1 = split(/$file/,$att_head);

my @arr_file_2 = split(/$end/,$arr_file_1[1]);

my $filename = $arr_file_2[0];

print "$filename\\n";

print "=================== BODY of file in BASE64 ========================\\n$att_file\\n";

$file_decode = decode_base64("$att_file=");

open (TMP,">c:\\\\$filename");

print TMP $file_decode;

close(TMP);


Остальные вариации на тему.

В принципе файл сохраняется. Его можно открыть(это архив, но... Имеем проблему ошибки CRC, попытка забора внешним клиентом - все чудно забирается и работает.

Так же обратил внимание на то, что просто при парсинге частей письма (имею ввиду частей отделенных boundary в multipart) В теле таких частей присутствует не обычный символ перевода строки, а несколько покалеченный или пара символов. в hex глянул 0А, тобишь 10. Пришлось извращаться что бы разбить полученное тело части на составляющие и вычленить имя вложения и непосредственно закодированное в Base64 тело файла... Но... Оба варианта хоть и воркают, но дают ошибку CRC, при этом я точно знаю, что в архиве два файла, но вижу только один. Ну это не удивительно, раз архив битый.

Content-type: application/octet-stream; name="AF1.zip"; type=Unknown;charset=win
dows-1251;
Content-description: AF1.zip
Content-transfer-encoding: Base64
Content-disposition: attachment; filename="AF1.zip"

UEsDBBQAAAAIAMIb9DLDN61vnQEAAMYCAAAMAAAAMUN2NzdDaHMuZGF0bVFNS8NAEL0X/A9lz7th
d7NJNp7MxwY8KeqxIDHdlmCahDS1YNv/1rOCXvwBIgj1YBXxrpukalpMspOZeW/eLDN7nVlgc8di
ro98x+aIEeIh7lGBsPBMwxEm1QMBwc3tHYCBSV1hmQGyBA0QM3yMXMPCyLddbjkm4TZxIXACALFg
wuCuQMTCPmKYWYhXoeMEuoeZaqB7EBBi03lF3+vMgBNdptk0kf2hHMm0HDdZRcHzqvliUcdelo7L
sIKb+EQOZCHTSDZ8w8ZWnWdGXQUBniszCuMkm5RbXgVg9ZLaMmpD3Egyc7f0MG0724UEcwJpczvD
1nktQdsKXfVQ9afa/fP76lOdl9fHr+7y6WP99r7+XH20NMGkuOif5+FVeTCcovxKG1yM+8OpFmUj
xVJfllwC1ZlAIPZ7p1ER52XvuMgG8VlPKWgYN/MHSwANYtYlywdliMI0pmsEVASiXcd57eGN18Z/
76CGvtjsJsomf0P3s2jS7KiJz+QoT8JSdo9yWYRlrHb0w5SJLGW/21rTNrAr9ZPf7bhJ/9tp8Q1Q
SwMEFAAAAAgAwhv0MoGVP+eAAAAAlQAAAAsAAAAxQ3Y3N0RsZC5pZBXMMQpCMQyA4V3wDtK5gaYv
bdIxbVLwGIKj+EYHfRdU8Ew+x3/4v+PhGWx93G/r5Xo6W4iziTJ1A9MmQIgDZGSH5KMW9ZqX6THo
DDE5eZHugJwMKBGD/FN1LiPRfi0jhvfnu6M1d+c6gT1PoGIJeuEE1rqwVpSGPQbEll+7vP0AUEsB
AhQAFAAAAAgAwhv0MsM3rW+dAQAAxgIAAAwAAAAAAAAAAgAgALaBAAAAADFDdjc3Q2hzLmRhdFBL
AQIUABQAAAAIAMIb9DKBlT/ngAAAAJUAAAALAAAAAAAAAAIAIAC2gccBAAAxQ3Y3N0RsZC5pZFBL
BQYAAAAAAgACAHMAAABwAgAAAAA=

А так выглядит отпарсенная часть тела письма с аттачем....

Собственно вопрос, как правильно перекодировать, что бы файл нормально открывался?
Или где здесь ошибка?
Может есть еще вараиция на тему?
Email::MIME::Attachment::Stripper Не хочет онработать под виндой, хоть тресни. Устал с ним бороться.

[NeoNox]

Неверен подход.
MIME::Parser ставится на твоей машине?
Вот тебе пример:
http://search.cpan.org/src/DSKOLL/MIME-tools-5.417/examples/mimedump

[Skif]

не хочет он у меня ставиться....

ppm>
ppm> install MIME::Parser
Searching for \'MIME::Parser\' returned no results. Try a broader search first.
ppm> search MIME::Parser
Searching in Active Repositories
No matches for \'MIME::Parser\'; see \'help search\'.
ppm>

[NeoNox]

http://ppm.activestate.com/PPMPackages/zips/6xx-builds-only/MIME-tools.zip ?

[Skif]

Ок, спасибо, сейчас гляну.

[Skif]

Увы, мне не удается его поставить:

C:\\MIME-tools>ppm MIME-Tools.ppd
Unknown or ambiguous command \'MIME-Tools.ppd\'; type \'help\' for commands.

C:\\MIME-tools>ppm install MIME-Tools.ppd
Error: no suitable installation target found for package MIME-tools.

C:\\MIME-tools>

или

ppm> install C:\\MIME-tools\\MIME-tools.ppd
Error: no suitable installation target found for package MIME-tools.
ppm>

или

ppm> install MIME::Tools -location=C:\\MIME-tools\\MIME-tools.ppd
Unknown option: location
Searching for \'MIME::Tools\' returned no results. Try a broader search first.
ppm>

ppm> install http://perl.ua/perl/MIME-Tools.ppd
Can\'t call method "name" without a package or object reference at C:/Perl/site/l
ib/PPM/UI.pm line 1077, line 6.

E:\\scripts\\1c_exch\\bin>

Короче не ставиться он, хотя в README четко написано:

To install this ActiveState PPM package, run the following command
in the current directory:

    ppm install MIME-tools-BETA.ppd

по большому счету MIME::Tools есть уменя в системе, но Parser отсутствует

[NeoNox]

Попробуй тогда руками его доставить из этого архива. Это перловый модуль.

[Skif]

Makefile.pl отсутствует, просто копированием - вылетают ошибки...
Короче не знаю как модуль впендюрить.

[ondr]

Skif
лезим на search.cpan.org и находим что MIME::Parser является включением в пакет MIME-tools
следовательно:
ppm install MIME-tools

[Skif]

Повторюсь, у меня стоит MIME-Tools, но там Parser отсутствует. Пробовал обновить но эффект нулевой, даже с ключем force.

[NeoNox]

Распакуй приложенный архив в папку с либами типа C:\\perl\\site\\lib

[ondr]

Skif
ради интереса
ppm uninstall MIME-tools
ppm install MIME-tools

какой результат и версия perl?

[Skif]

NeoNox
спасибо,но помог снос перла и установка его заново с обновлением всех пакетов.
ТОгда и парсер появился
ondr
Если говорю uninstall то в ответ, что такого пакета нету, если инсталл (впрочем я и так помню, что его сам ставил) то говорит, что такой пакет пристутствует.
=============

А вообще, вроде бы поставил, после переинстала перл не ругается, пока буду пробовать содержимое.

[Skif]

Вопрос, по парсер, немогу понять, как извлечь от-туданапример само тело файла:

for ($i = 1; $i <= $pop->Count(); $i++) {

foreach ( $pop->Head( $i ) ) {

my $from_mess = \'\';

my $subject_mess = \'\';

/^From:\\s+/i and  $from_mess = $_;

my $message = $pop->HeadAndBody($i);

###############################

my $parser = new MIME::Parser;

$parser->output_under("e:\\\\scripts\\\\1c_exch\\\\tmp");

my $entity = $parser->parse_data($message);

#my $subject = $entity->head->get(\'Subject\');

print "Subject: $subject";

my $from = $entity->head->get(\'from\');

print "From: $from";

if ($entity->is_multipart) {

print "This is message is multipart! Nimbers of parts - ";

my $size_a = $entity->parts();

print $size_a, "\\n";

for (my $ind = 0; $ind <  $size_a; $ind++) {

print "<<<<======================== $ind =========================>>>>\\n";

my $part = $entity->parts($ind);

print $part->as_string,"\\n";

}

} else {

$entity->body_as_string;

}       

###############################

print "\\n";

}

Тобишь как строки я получил файл, но как слепить его в нужный мне аттач и сохранить на диск?

[NeoNox]

Тебе нужно рекурсивно разбирать мультипарт.
Посмотри на пример который я выше ссылку дал.