設定ファイルで指定したファイルを添付して送るperlスクリプト

設定ファイルはYAMLで以下のようなもの。
添付ファイル一つ目はUTF-8のテキスト。二つ目はpngの画像という設定。
attachmentが配列なのでどんどん追加していくことができる。
また、オマケとしてファイルパスや指定する添付ファイル名に日付が入っている場合に対応しており [% today,%Y%m%d %] といった形で指定する。スクリプトを見てもらえばわかるがstrftimeのフォーマット。

---
from: [メール送信元アドレス]
to: [メール送信先アドレス]
subject: [メールのサブジェクト]
body: |+
  [メール本文]

content_type: text/plain
charset: UTF-8
encoding: base64
attachment:
  - content_type: text/plain
    charset: UTF-8
    encoding: base64
    content: [添付ファイル一つ目のファイルパス]
  - content_type: image/png
    encoding: base64
    content: [添付ファイル二つ目のファイルパス]
    name: [添付ファイル二つ目のファイル名を指定]

以下スクリプト。

use utf8;
use warnings;
use Email::MIME;
use Email::Send;
use POSIX qw(strftime);

use YAML;
my $conffile = shift @ARGV;
open my $fh,"<",$conffile or die $!;
binmode $fh,":utf8";
my $confdata;
{
  local $/ = undef;
  $confdata = <$fh>;
}
close $fh;
my $conf = YAML::Load($confdata);

my @attachment;
my @today = localtime(time);
my @yesterday = localtime(time - 86400);
foreach(@{$conf->{attachment}}){
  my $body;
  my $path = $_->{content};

  $path =~ s/\[% today,((?:%Y)?(?:%m)?(?:%d)?) %\]/strftime($1,@today)/geo;
  $path =~ s/\[% yesterday,((?:%Y)?(?:%m)?(?:%d)?) %\]/strftime($1,@yesterday)/geo;
  open my $fh,"<",$path or die $!;
  binmode $fh;
  my $buf;
  while(read($fh,$buf,1024)){
    $body.=$buf;
  }
  close $fh;

  my %attributes;
  if(defined $_->{name}){
    $_->{name} =~ s/\[% today,((?:%Y)?(?:%m)?(?:%d)?) %\]/strftime($1,@today)/geo;
    $_->{name} =~ s/\[% yesterday,((?:%Y)?(?:%m)?(?:%d)?) %\]/strftime($1,@yesterday)/geo;
  }
  foreach my $k (qw(content_type charset encoding name)){
    $attributes{$k} = $_->{$k} if defined $_->{$k};
  }

  $attributes{disposition} = 'attachment';
  unless(defined $attributes{name}){
    $path =~ s/^.+\/([^\/]+?)$/$1/;
    $attributes{name} = $path;
  }
  push @attachment,Email::MIME->create(
    attributes => \%attributes,
    body => scalar $body
  );
}

my $email = Email::MIME->create(
  header_str =>[
    From => $conf->{from},
    To => $conf->{to},
    Subject => $conf->{subject},
  ],
  parts => [
    Email::MIME->create(
      attributes=>{
        content_type=> $conf->{content_type},
        charset=> $conf->{charset},
        encoding => $conf->{encoding},
      },
      body_str => $conf->{body},
    ),
    @attachment
  ],
);

Email::Send->new()->send($email);

[参考]
http://gihyo.jp/dev/serial/01/modern-perl/0020