Perl メールサーバマシン上で添付ファイル処理

（2008/06/17perlfreak.vox.comより転載）

メールの添付ファイルを指定ディレクトリに保存する。
指定ディレクトリ下にFrom:のアカウントでサブディレクトリを作り、その下にタイムスタンプ+拡張子でファイルを保存する。
引数は2つ。1つめは、ファイル保存ディレクトリのパス。2つめは、メールスプールファイルのディレクトリパス。
aliasesで

foo: |"/usr/local/bin/save_attached.pl /var/spool/attached"

のように指定し、メールを受信する度に処理する場合は、2つめの引数は指定しない。
一度受信したメールを処理する場合は、2つめの引数が必要。cronで定期実行する。
処理対象は、From:が@hoge.comのものに限定している。

===（save_attached.pl ここから）===
#!/usr/bin/perl -w

use MIME::Parser;
use MIME::Base64 qw/ decode_base64 /;
#use warnings;
use strict;

my $check_domain = 'hoge.com';
my $save_path = "";
my $spool_path = "";

# 引数チェック
if ( $ARGV[0] ) {
$save_path = $ARGV[0];
$save_path =~ s/\/$//;
unless ( -d $save_path ) {
exit;
}
}
else {
exit;
}

if ( $ARGV[1] ) {
$spool_path = $ARGV[1];
$spool_path =~ s/\/$//;
unless ( -d $spool_path ) {
exit;
}
}

my $parser = new MIME::Parser;
$parser->output_to_core( 1 );

if ( $spool_path ne "" ) {
opendir INDIR, $spool_path or die;
while ( my $spool_file = readdir INDIR ) {
chomp $spool_file;
my $spool_file_path = $spool_path . '/' . $spool_file;
if ( $spool_file =~ /^\d+\.$/ and -f $spool_file_path ) {
my $account = "";

# ファイルデータを取得
open IN, "< $spool_file_path" or next; my $buff = do { local $/; };
close IN;

my $entity = $parser->parse_data( $buff ) or next;
my $from = $entity->head->get( 'from' );
chomp $from;

# Fromアドレスのチェック
if ( $from =~ /([_\.a-zA-Z0-9]+)\@$check_domain/ ) {
$account = $1;
}
else {
system( "/bin/rm", $spool_file_path );
next;
}

# 添付ファイル保存
if ( $entity->is_multipart ) {
&_save_attached_file( $entity, $save_path, $account );
system( "/bin/rm", $spool_file_path );
}
}
}
closedir INDIR;
}
else {
my $account = "";
my $entity = $parser->parse( \*STDIN ) or die;
my $from = $entity->head->get( 'from' );
chomp $from;

# Fromアドレスのチェック
if ( $from =~ /([_\.a-zA-Z0-9]+)\@$check_domain/ ) {
$account = $1;
}
else {
exit;
}

# 添付ファイル保存
if ( $entity->is_multipart ) {
&_save_attached_file( $entity, $save_path, $account );
}
}

exit;

#=== FUNCTION ================================================================
# NAME: _save_attached_file
# PURPOSE: 添付ファイル保存
# DESCRIPTION: 添付ファイルを保存する。
# PARAMETERS: メールエンティティ、保存先ディレクトリパス、アカウント
# RETURNS: なし
#===============================================================================
sub _save_attached_file() {

my ( $entity, $save_path, $account ) = @_;
my $date = &_get_date();
my $parts_count = $entity->parts;
for ( my $i = 1; $i < $parts_count; $i++ ) { my $part_entity = $entity->parts( $i );
my $filename = $part_entity->head->recommended_filename;
if ($filename =~ /\=\?ISO\-2022\-JP\?B\?(.+)\?\=/ ) {
$filename = $1;
$filename = decode_base64( $filename );
}

my $ext = "";
if ( $filename =~ /\.(\w+?)$/ ) {
$ext = $1;
}

my $new_filename = $date . '_' . $i;
if ( $ext ne "" ) {
$new_filename = $new_filename . '.' . $ext;
}

my $save_dir = $save_path . '/' . $account;
unless ( -d $save_dir ) {
system( "/bin/mkdir", $save_dir );
}
my $save_file = $save_dir . '/' . $new_filename;

open OUT, "> $save_file" or next;
print OUT $part_entity->bodyhandle->as_string;
close OUT;
}

}

#=== FUNCTION ================================================================
# NAME: _get_date()
# PURPOSE: 年月日時分秒
# DESCRIPTION: 年月日時分秒を返す。
# PARAMETERS: なし
# RETURNS: YYYYMMDDHHMISS
#===============================================================================
sub _get_date() {

my( $sec, $min, $hour, $mday, $mon, $year ) = (localtime)[0,1,2,3,4,5];
$year+=1900;
$mon++;
$sec = sprintf("%02d", $sec);
$min = sprintf("%02d", $min);
$hour = sprintf("%02d", $hour);
$mday = sprintf("%02d", $mday);
$mon = sprintf("%02d", $mon);

return $year . $mon . $mday . $hour . $min . $sec;

}
===（save_attached.pl ここまで）===