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;
トラックバック URL:
https://perltips.twinkle.cc/trackback/35