perl sendmail发送带附件的html邮件

最近要写个perl脚本发送带附件的html格式的邮件，要求从csv中读取发件人，收件人，以及邮件html body中的变化部分，好久没写perl脚本，有点吃力了。。:)

#!/usr/local/bin/perl -w

use strict;
use warnings;

if($#ARGV != 0){
    die "Usage: $0 ";
}

# static properties
my $email_subject = 'welcome to visit thejtechs.com';
my $thejtechs_attachment = get_attachment('thejtechs.pdf');
my $faq_attachment = get_attachment('FAQ_thejtechs.pdf');
my $email_cc = 'thejtechs@163.com';

# dynamic properties
my ($email_from, $email_to, $dear, $sincerely, $email_body);

my $email_body_template = q{"


    welcome to visit thejtechs.com



  
  

    
   
   

        Dear $dear
    
    
   
   

        We would like you to join thejtechs.com.
    
    
   
   
Why join? clicking here.
    
    
   
   
If you have further questions you can contact thejtechs (thejtechs\@163.com).
    
    
   
   
Sincerely,

        $sincerely
    

  
  


"};

#start main
main();
sub main {
    open FFF, '<', $ARGV[0] or die "can not open $ARGV[0] $!\n";
    my $flag = 0;
    while(<FFF>){
        if( $flag == 0){ #skip header
            $flag = 1;
            next;
        };
        chomp $_;
        next if /^\s*$/;
        my $line = $_;
        $line =~ s/\cM\Z//;
        $line =~ s/,/\|/g;
        my $new_line = '';
        while ( $line =~ m{"[^"\|]+(?=\|)}g ) {
            $line = $& . ',' . substr($', 1) ;
            $new_line .= $`;
        }
        $new_line .= $line;
        $new_line =~ s/"//g;
        #print $new_line . "\n";
        my @content = split '\|', $new_line;
        ($email_from, $email_to, $dear, $sincerely) = @content[4,12,11,3];
        $email_from =~ s/;/,/g;
        $email_to =~ s/;/,/g;
        $email_body = eval($email_body_template);
        email_send(
            subject   => $email_subject,
            from      => $email_from,
            to        => $email_to,
            cc        => $email_cc,
            body_html => $email_body,
            'ATTACHMENT' => [{BODYPTR=>\$thejtechs_attachment, FILENAME=>"thejtechs.pdf"},
                                 {BODYPTR=>\$faq_attachment, FILENAME =>"FAQ_thejtechs.pdf"}
                            ]
        );
    }
    close(FFF);
}

sub get_attachment{
    my $filename = shift;
    my $filesize = (-s $filename);
    my $file_attachment;
    open(OUT, $filename) or warn "Can not open file $filename: $!";
    read(OUT, $file_attachment, $filesize) or warn "Can not read to file $file_attachment: $!";
    close(OUT);
    return $file_attachment;
}

sub email_send {
    my %arg = @_;
    my ($cc, $subject, $body, $body_html);
    if (exists $arg{cc}) { $cc = $arg{cc}; }
    else { $cc = ""; }
    if (exists $arg{subject}) { $subject = $arg{subject}; }
    else { $subject = ""; }
    if (exists $arg{body_html}) { $body_html = $arg{body_html}; }
    else { $body_html = ""; }
    if (exists $arg{body}) { $body = $arg{body}; }
    else { $body = ""; }
    my ($to, $from);
    if (exists($arg{to})) { $to = $arg{to}; }
    else {
           return(0);
    }
    if (exists($arg{from})) { $from = $arg{from}; }
    else {
       return(0);
    }

    my $mailprog = "/usr/lib/sendmail -t";
    open(SENDMAIL, "|$mailprog") || eval {
        return(0);
    };

    print SENDMAIL "To: $to\n";
    print SENDMAIL "From: $from\n";
    print SENDMAIL "CC: $cc\n" if (defined $cc);
    print SENDMAIL "Subject: $subject\n" if (defined $subject);
    my $boundary="--Boundary-com=_thejtechscom";
    if ($arg{ATTACHMENT}) {
        print SENDMAIL "Content-Type: Multipart/Mixed; boundary=\"$boundary\"\n",
                       "MIME-Version: 1.0\n",
                       "\n",
                       "\n--$boundary\n";
    }
    print SENDMAIL "Content-Type: multipart/alternative;\n boundary=\"$boundary\"\n",
                "MIME-Version: 1.0\n",
                "\n",
                "\n--$boundary\n",
                "Content-Type: text/plain; charset=us-ascii\n",
                "Content-Transfer-Encoding: 7bit\n\n";
    print SENDMAIL "$body\n" if (defined $body);
    print SENDMAIL "\n--$boundary\n",
                  "Content-Type: text/html; charset=us-ascii\n",
                  "Content-Transfer-Encoding: 7 bit\n\n";
    print SENDMAIL "$body_html\n" if (defined $body_html);

    if ($arg{ATTACHMENT}) {
        $arg{ATTACHMENT}=[$arg{ATTACHMENT}] if ref($arg{ATTACHMENT}) eq 'HASH'; 
        foreach my $hash_ptr ( @{$arg{ATTACHMENT}}) {
            my $encrypted='';
            my $attname=$hash_ptr->{FILENAME};
            my $bodyptr=$hash_ptr->{BODYPTR};
            if (defined($hash_ptr->{LOCALFILENAME})) {
                if (open(ATTFILE,$hash_ptr->{LOCALFILENAME})) {
                    my $buf;
                    read(ATTFILE,$buf,(-s ATTFILE));
                    close(ATTFILE);
                    $bodyptr=\$buf;
                } else {
                    return(0); # error
                }
            }
            $encrypted=$$bodyptr;
            print SENDMAIL "\n--$boundary\n",
                           "Content-Type: application/octet-stream; name=\"$hash_ptr->{FILENAME}\"\n",
                           "Content-Transfer-Encoding: x-uuencode\n",
                           "Content-Disposition: attachment; filename=\"$attname\"\n",
                           "\n",
                           "begin 644 $attname\n",
                           pack('u',$encrypted),
                           "`\nend\n"; 
        }
        print SENDMAIL "\n--$boundary--\n";
    }
    close(SENDMAIL);
}

详情参考： http://www.thejtechs.com/blogDetail/73/perl-sendmail-for-attachment-html-mail