Perl解析多部分/替代电子邮件

Question

我正在寻找一种方法来解析多部分/替代电子邮件的正文部分.我目前有一个使用Email :: Mime模块的perl脚本,它正确解析text/plain和text/html.虽然我遇到的问题是,当我解析多部分/替代电子邮件时,$ part-> body总是返回空.我尝试过使用$ part-> body_raw,虽然它包含了我需要省略的标题,但它确实返回了文本正文.

使用$ part-> data_raw的当前输出

--_000_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_
Content-Type: text/plain; charset="us-ascii"
Content-Transfer-Encoding: quoted-printable 

Text Body 

期望的输出

Text Body

PERL代码

my ( $body, $text_body, $html_body, $multi_body );
for my $part (@parts) {

if ( $part->content_type =~ m!text/html! ) {
    my $hs = HTML::Strip->new( emit_spaces => 0 );
    $html_body .= $hs->parse( $part->body );
    print "Found HTML\n";
}
elsif ($part->content_type =~ m!text/plain!
    or $part->content_type eq '' )
{

    $text_body .= $part->body;
    print "Found TEXT\n";
}
elsif ($part->content_type =~ m!multipart/alternative!
    or $part->content_type eq '' )
{
    print "Found Multipart\n";
    $multi_body .= $part->body;     

}

资源

Content-Type: multipart/related;
boundary="_004_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_";
type="multipart/alternative"
MIME-Version: 1.0

--_004_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_
Content-Type: multipart/alternative;
boundary="_000_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_"

--_000_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_
Content-Type: text/plain; charset="us-ascii"
Content-Transfer-Encoding: quoted-printable

Test Body

Answer 1

多部分包含多个部分.迭代他们:

use strict;
use warnings;
use Email::MIME;
use Data::Printer;
use feature qw/say/;

my $source = <<EOF;
Content-Type: multipart/related;
boundary="_004_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_";
type="multipart/alternative"
MIME-Version: 1.0

--_004_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_
Content-Type: multipart/alternative;
boundary="_000_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_"

--_000_47C8E15E8EEDCB4E94E891F9414C019A0CB5BDEE79DFW1MBX07mex0_
Content-Type: text/plain; charset="us-ascii"
Content-Transfer-Encoding: quoted-printable

Test Body
EOF

my $msg = Email::MIME->new($source);

for my $part ($msg->parts) {
    if ($part->content_type =~ m!multipart/alternative!
            or $part->content_type eq '' )
        {
            say "Found Multipart"; 
            for my $subpart ($part->parts) {
                say $subpart->body;
            }
    }
}

输出:

C:\>perl test_mime.pl 
Found Multipart 
Test Body