Perl で、メールサーバに送られてきたメールを処理する

Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。

使用するクラス 


use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use MIME::Parser; use MIME::Base64; use Mail::Address; use Unicode::Japanese; my ($mail) = &parse; print "From: " . $mail->{sender} . "\n"; print "To: " . $mail->{recipient} . "\n"; print "Subject: " . $mail->{subject} . "\n"; sub parse { 
my ($mail);

# Parser Setting
my $parser = new MIME::Parser;
$parser->output_to_core(1);    # Keeps body analyzed internally
$parser->tmp_recycling (1);    # Recycles the temporary stuff

my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

# Headers
$mail->{sender   } =  $entity->head->get('from'   );
$mail->{subject  } =  $entity->head->get('subject');
$mail->{recipient} =  $entity->head->get('to'     );
$mail->{recipient} =~ s/\n//g;

# From
@addrs = Mail::Address->parse($mail->{sender});
foreach $addr (@addrs) {
    $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
}

# Subject
my $subject = $mail->{subject};
$lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
$ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
$subject  =~ s/\n//g;
$subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
$subject  =~ s/$lws/ /go;
$subject  =~ s/$ew_regex/decode_base64($1)/egio;
$subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
$mail->{subject} = $subject;

# Get MIME
($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
$mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
$mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
$mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

return $mail;
} sub getEntities { 
my $entity = shift;
my $body, $filename, $mimetype, $object;

# BODY
my @parts = $entity->parts;
if (@parts) {                   # multipart...

    my $i;
    foreach $i (0 .. $#parts) { # dump each part...

        &getEntities($parts[$i]);
    }
} else {                        # single part...

    # Get MIME type, and display accordingly...
    my ($type, $subtype) = split('/', $entity->head->mime_type);
    my $bodyhandle = $entity->bodyhandle;

    if ($type =~ /^(text|message)$/) {      # text

        $body .= $bodyhandle->as_string;

    } else {                                # binary

        $filename= $entity->head->recommended_filename;
        $mimetype = $entity->head->mime_type;
        $object = $bodyhandle->as_string;
        binmode($object);
        # if we want to store it as BASE64, you can continue the processs here
    }
}

return ($body, $filename, $mimetype, $object);
} 1;

Comments