perlのNet::SMTP + MIME::Entity で、添付ファイル付のメールを自動送信

次の通リ

#!/sing/local/perl/bin/perl
use strict;
use warnings;
use utf8;
use FindBin;
use File::Spec;
use lib File::Spec->catdir($FindBin::Bin, '../lib');
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Date::Calc qw/Add_Delta_YMD Today/;
use Encode;
use File::Temp qw/tempfile tempdir/;
use MIME::Entity;
use Net::SMTP;
use Sing::DBI;
use Sing::Model::User;
use Text::CSV_XS;
use Data::Dumper;

my $CONF =
    {smtp=>{host=>'tx.ないしょ.co.jp',
            port=>587,
            uid=>'ないしょ',
            passwd=>'ないしょ',
            from=>'ないしょ',
            debug=>1 },
     msg_subject=>'ないしょ',
     csv_filename=>'ないしょ',
     zip_filename=>'ないしょ'
    };

my $MSG_BODY_STR =<<EOF;
ないしょ
EOF

my $DBH;
my $USER;

main();
exit(0);

sub main {

    $DBH = Sing::DBI->connect();
    $USER = Sing::Model::User->get_sys_user($DBH);

    # $dbh->commit()
    my @today = Date::Calc::Today();
    my $delivery_infos = get_interior_delivery_info(\@today);

    for my $mailto (keys %$delivery_infos ){
        my $csv_lines = conv_meisais2csv($delivery_infos->{$mailto});
        my $tmp_attach_file = conv_csv_lines2zip($csv_lines);
        send_delivery_info([$mailto],[], $tmp_attach_file);
    }

    $DBH->disconnect();
    return 1;
}

#CSVなレコード群をZIPファイルに変換
sub conv_csv_lines2zip {
    my ($csv_lines) = @_;

    my $zip = Archive::Zip->new();

#CSVな文字列群を一度、ファイルに書き出すなら、以下
#    my ($tmp_csv_fh, $tmp_csv_filename) = tempfile;
#    print $tmp_csv_fh encode('cp932',join("\n",@$csv_lines));
#    $zip->addFile($tmp_csv_filename,encode('cp932',$CONF->{csv_filename}));

    my $string_member = $zip->addString(encode('cp932',join("\n",@$csv_lines)),
                                        encode('cp932',$CONF->{csv_filename}));

    my ($tmp_zip_fh, $tmp_zip_filename) = tempfile;
    unless ( $zip->writeToFileNamed($tmp_zip_filename) == AZ_OK ) {
        die "Archive::Zip write error $!";
    }
    return $tmp_zip_filename;
}

#DBからselect & fetchしたレコード群をCSVな文字列群に変換
sub conv_meisais2csv {
    my ($meisais) = @_;
    my $csv = Text::CSV_XS->new ({binary =>1});

    my @ret;

    my @cols =
        qw/ないしょ ないしょ ないしょ/;
    unless( $csv->combine( @cols ) ){
        die "can't Text::CSV_XS::combine ". join(",",@cols) . "$!";
    }
    push(@ret,$csv->string(@cols));

    for my $meisai ( @$meisais ){
        @cols =
            ($meisai->{reply_delivery_date},
             $meisai->{reply_delivery_to},
             $meisai->{heim_teicode},
             $meisai->{official_id},
             $meisai->{hinmei},
             $meisai->{hinban},
             $meisai->{color},
             $meisai->{size},
             $meisai->{hachuu_quantity});

        unless( $csv->combine( @cols ) ){
            die "can't Text::CSV_XS::combine ". join(",",@cols) . "$!";
        }
        push(@ret,$csv->string(@cols));
    }

    return \@ret;
}

sub get_interior_delivery_info {
    my ($date) = @_;

    my $sql =<<EOF;
select
  mail,
  h.reply_delivery_date,
  h.reply_delivery_to,
  j.heim_teicode, 
  h.official_id,
  hm.*
from hachuu h
ないしょ
where h.reply_delivery_date between ? and ?
order by d.mail, h.reply_delivery_date desc, h.reply_delivery_to,
         h.official_id, hm.page_id, hm.row_id;
EOF
    my $sth = $DBH->prepare($sql);
    my @vals = (sprintf("%04d-%02d-%02d", Add_Delta_YMD(@$date,0,-1,0)),
                sprintf("%04d-%02d-%02d", Add_Delta_YMD(@$date,0, 1,0)) );
    unless ( $sth->execute(@vals) ){
        return {};
    }

    my $ret = {};
    while(my $row = $sth->fetchrow_hashref() ){
        if(not defined($ret->{$row->{mail}}) ){
            $ret->{$row->{mail}} = [];
        }
        push( @{$ret->{$row->{mail}}}, $row);
    }

    return $ret;
}


sub send_delivery_info {
    my ($mailto,$mailcc, $tmp_attach_file) = @_;

    #mailtoがない場合、送信は行いません
    if( ref($mailto) ne "ARRAY" or
        @$mailto < 1 ){
        return 1;
    }

    my $smtp = Net::SMTP->new($CONF->{smtp}->{host},
                              Hello=>$CONF->{smtp}->{host},
                              Port=> $CONF->{smtp}->{port},
                              Timeout=>20,
                              Debug=>$CONF->{smtp}->{debug}
                             );

    #smtp-authでない場合、以下の認証は不要です
    unless ($smtp->auth($CONF->{smtp}->{uid},
                        $CONF->{smtp}->{passwd} )){
        my $msg = "can't login smtp server:$!";
        die $msg;
    }

    $smtp->mail($CONF->{smtp}->{from});
    $smtp->to(@$mailto);
    if( ref($mailcc) eq "ARRAY" and scalar(@$mailcc) > 0){
        $smtp->cc(@$mailcc);
    }
    $smtp->data();
    my $mime = MIME::Entity->build(From=> $CONF->{smtp}->{from},
                                   To  => join(',',@$mailto),
                                   Subject=>
                                   encode('iso-2022-jp',$CONF->{msg_subject}),   

                                   Type   =>'text/plain; charset="ISO-2022-JP"',
                                   Encoding => "7bit",
                                   Data  => [encode('iso-2022-jp',$MSG_BODY_STR)] );

    $mime->attach(
                  Filename => $CONF->{zip_filename},
                  Path => $tmp_attach_file,
                  #次の様にCSVの文字列を直接指定することのできます
#                  Data => encode('cp932',join("\n",@$csv_lines)),
                  Type => 'application/zip',
                  Encoding => 'base64'
#                  Encoding => '-SUGGEST'

                 );
    $smtp->datasend($mime->stringify);
    $smtp->dataend();
    $smtp->quit;
}