用Perl自动发送带有附件的电子邮件

用Perl自动发送带有附件的电子邮件

用Perl自动发送电子邮件使用的是Net::SMTP::SSL模块，发送附件依然需要用它，但是会增加一个模块MIME::Lite。我想许多人和我一样，看到Lite就会触发一些温伯格所说的小小的心理活动,可事实上MIME::Lite的功能是非常强大的。

下面是发送附件的Perl代码，和从前一样，尽量不解释。

#!/usr/bin/perl
## Copyright (c) 2012 by novice(http://www.hailongchang.org)

use strict;
use Net::SMTP::SSL;
use MIME::Lite;

my  $mail_from = "hailongchang165210\@gmail.com";
my  $mail_to = "535260440\@qq.com";
my  $mail_cc = "535260440\@qq.com";
my  $google_username = "hailongchang165210\@gmail.com";
my  $google_password = "***************";
my  $mail_subject = "Perl自动发送邮件\n";

sub     SendAttachMail
{
    my $mail_content = shift;
    my $mail_attach = shift;

    my $smtp = Net::SMTP::SSL->new(
                        'smtp.gmail.com',
                        Hello=>'hailongchang.org',
                        Port=>465,
                        LocalPort=>0,
                        Debug=>1);

    die("smtp undefined: $@") if !defined $smtp;

    my $auth_return = $smtp->auth($google_username,$google_password);
    die("auth error: $@") if !defined $auth_return;

    my @tmp = split/\\/,$mail_attach;
    my $attach_name = pop(@tmp);

    my $msg=MIME::Lite->new(
                    From=>$mail_from,
                    To=>$mail_to,
                    Cc=>$mail_cc,
                    Subject=>$mail_subject,
                    Type=>'TEXT',
                    Data=>$mail_content,);

    $msg->attach(
            Type=>'AUTO',
            Path=>$mail_attach,
            Filename=>$attach_name,);

    my $content_string=$msg->as_string() or die "$!";

    $smtp->mail($mail_from);
    $smtp->to($mail_to);
    $smtp->data();
    $smtp->datasend($content_string);
    $smtp->dataend();
    $smtp->quit;
}

#SendAttachMail测试成功
SendAttachMail("附件是一个excel文件",'D:\temp_code\perl_code\aws.xls');

 

 

 

 

 

 

如果仅仅只是发送不带附件的邮件，请参考如何用Net::SMTP发送邮件。

这里使用 MIME::Lite 模块来发送附件。分为两种情况，一种是 SMTP 服务器不需要验证的，另一种是需要验证/auth 的。

情况一：SMTP 服务器不需要验证

这种情况下可以参考 perldoc MIME::Lite. 还有个更详细的例子在 Cooking with perl.
一个简单的 Example:

use MIME::Lite;


my $msg = MIME::Lite->new(From    => 'sender@example.com',
             To      => 'recipient@example.com',
             Subject => 'My photo for the brochure',
             Type    => 'multipart/mixed');
$msg->attach(Type        => 'image/jpeg',
             Path        => '/Users/gnat/Photoshopped/nat.jpg',
             Filename    => 'gnat-face.jpg');
$msg->attach(Type        => 'TEXT',
             Data        => 'I hope you can use this!');
#$msg->send(  );            # default is to use sendmail(1)
# now we use smtp.
$msg->send('smtp', 'mailserver.example.com');

情况二：SMTP 服务器需要验证/auth

现在的 SMTP 服务器大部分都需要验证，我猜测可能的原因是为了防止垃圾邮件。
MIME::Lite 中是不支持 SMTP 验证/auth 的。所以我们一般将 MIME::Lite 转为 string, 然后通过验证后的 Net::SMTP 来发送。详细的代码如下（已测试成功）：

#!/usr/bin/perl -w


use strict;
use Net::SMTP;
use Authen::SASL;
use MIME::Lite;


my $mailhost="mail.chinahcn.com";
my $mailfrom='gaochong@chinahcn.com';
my $mailto='gaochong@chinahcn.com';
my $subject="this is subject";
my $text="textntext";
my $attach="/usr/local/tomcat/img/logo.gif";


my $smtp=Net::SMTP->new($mailhost,Hello=>'localhost',Debug=>1);
$smtp->auth('gaochong@chinahcn.com','passwd');


my $msg=MIME::Lite->new(
        From=>$mailfrom,
        To=>$mailto,
        Cc=>'jjgaochong@yahoo.com.cn',
        Subject=>$subject,
        Type=>'TEXT',
        Data=>$text,
);
$msg->attach(
        Type=>'image/gif',
        Path=>$attach,
        Filename=>'hello.gif',
);
my $str=$msg->as_string() or die "$!";
#foreach my $mailto (@mailto) {
        $smtp->mail($mailfrom);
        $smtp->to($mailto);
        $smtp->data();
#       $smtp->datasend("To:$mailton");
#       $smtp->datasend("From:$mailfromn");
#       $smtp->datasend("Subject:$subjectn");
#       $smtp->datasend("n");
#       $smtp->datasend("$textn");


        $smtp->datasend($str);
        $smtp->dataend();
#}
$smtp->quit;

最近一直很郁闷，要维护10所大学服务器，假如服务器的磁盘满了，或者其它原因，能不能早点发现呢？我就想到了，弄个脚本，监控服务器，有异常时，发封邮件给我，就OK了。我原来一直想使用系统自带的sendmail来实现我的想法，由于对sendmail不熟，一直弄不好。只到今天，嘿嘿，在看一个网站时，看到使用php发邮件的方法。记得装软件时，没有装php，但是有装perl啊，就这么办，使用perl来发邮件。过程如下：

1、登录系统

2、查询是否有安装perl

　　[root@CentOS ~]# rpm -qa | grep perl
　　　　perl-5.8.5-36.RHEL4

3、OK，来检查一下网络

　　[root@CentOS ~]# ping act0r.bokee.com
　　PING act0r.bokee.com (58.49.57.34) 56(84) bytes of data.
　　64 bytes from 58.49.57.34: icmp_seq=0 ttl=54 time=128 ms

4、安装发邮件所需要的模块

　　[root@CentOS ~]# perl -MCPAN -e shell

　　　　基本上是一路回车，只有到最后面时，会让你选择你所在的区域，及国家。

　　cpan>install Authen::SASL

　　cpan>q

5、vi /etc/init.d/sendmail.sh

#!/usr/bin/perl
use Net::SMTP;

my $mailhost = "smtp.163.com"; # SMTP服务器
my $mailfrom = 'notfour@163.com'; # 你的EMAIL地址
my @mailto = ('fayland@gmail.com', 'not_four@hotmail.com'); # 收信人地址
my $subject = "此为标题";
my $text = "此为正文\n第二行位于此。";

$smtp = Net::SMTP->new($mailhost, Hello => 'localhost', Timeout => 120, Debug => 1); #为0时，不输出调试信息

# anth login, type your user name and password here
$smtp->auth('user','pass'); ＃＃＃用户名和密码

foreach my $mailto (@mailto) {
# Send the From and Recipient for the mail servers that require it
$smtp->mail($mailfrom);
$smtp->to($mailto);

# Start the mail
$smtp->data();

# Send the header
$smtp->datasend("To: $mailto\n");
$smtp->datasend("From: $mailfrom\n");
$smtp->datasend("Subject: $subject\n");
$smtp->datasend("\n");

# Send the message
$smtp->datasend("$text\n\n");

# Send the termination string
$smtp->dataend();
}
$smtp->quit;


6、给sendmail执行权限

　　[root@CentOS ~]# chmod 755 /etc/init.d/sendmail.sh

7、测试

　　[root@CentOS ~]# /etc/init.d/sendmail.sh

8、嘿嘿，看看信发送了没有。