Sending email with attachments from Perl – the easy way
Since I’ve already had my Linux box set up as an SMTP server, I can just use the built in sendmail capabilities of Mail::Sendmail. I could easily have it use an external SMTP server by specifying it in the $mail{smtp} hash variable.
In this example, I’m going to send a hard coded HTML string to my dbS::EMail along with a jpeg of the Enterprise. Why wrap Mail::Sendmail in a perl module and not use it directly? I wish to make it as simple as possible for myself by hiding the complexities.
use strict;
use warnings;
use dbS::EMail;
my $message < <eof>
This past Sunday my 30GB iPod photo finally died. It lasted just over three years and it was a true veteran. It was dropped, kicked, washed (accidentally), and chewed on by Tonks. Sunday afternoon after returning from the <a href="http://froebe.net/blog/2007/08/26/more-photos-of-our-house/">build site of the new house</a>, I went back out to the car and dropped the iPod three times in 60 seconds. Low and behind it finally died. I took it apart, reseated everything but when the iPod started, I heard the click click of a dead hard drive. After an hour of trying to coax it back to life, <a href="http://www.froebe-fibers.com" onclick="return alinks_click(this);" class="alinks_links" title="Rebecca Froebe" style="background: transparent url(‘http://froebe.net/blog/wp-content/plugins/alinks/images/external.png’) no-repeat scroll right center; padding-right: 13px; -moz-background-clip: -moz-initial; -moz-background-origin: -moz-initial; -moz-background-inline-policy: -moz-initial" rel="external">my wife</a> offered to buy a new 30GB Video iPod for my birthday.
I loaded it up with podcasts, music and video. What I’ve noticed is that when I go iPod -> Music -> Podcasts -> <a href="http://chris.pirillo.com/media/">The Chris Pirillo Show</a>, I saw a normal podcast and no video. After a few seconds of thinking I messed something up, I didn’t, I tried iPod -> Video Podcasts -> <a href="http://chris.pirillo.com/media/">The Chris Pirillo Show</a> and video was found <img src="http://froebe.net/blog/wp-includes/images/smilies/icon_smile.gif" alt=":)" class="wp-smiley" /> I would have thought that it wouldn’t make any difference if I played the video podcast from “Podcasts” or “Video Podcasts”, but apparently it does.
EOF
if ( dbS::EMail::simple_send(‘jason@froebe.net.nospam’, $PROC . ‘: test email with attached jpg’ , $message, undef, { type => ‘text’, ‘files’ => "/home/jfroebe/enterprise.jpg" } ) ) {
print "SUCCESS! Email sent\\n";
} else {
print "ERROR: Email send failed\\n";
printf "ERROR: Email Transport: %s\\n", $dbS::EMail::error if $dbS::EMail::error;
printf "ERROR: Email Transport Log: %s\\n", $dbS::EMail::log if $dbS::EMail::log;
}
exit;</eof>
The following is the dbS::EMail Perl Module. Note that when we are sending regular text, we are still sending MIME encoded. That’s not a bad thing but could annoy some people on antique email clients. Attachments are handled by sending a filename path to the module which will attempt to determine what type of file it is by using File::MMagic and then encode the file using MIME::Base64. All subroutines starting with the underscore “_” are considered internal subroutines and shouldn’t be accessed outside of the module.
use warnings;
use strict;
use File::Basename;
use File::MMagic;
use Mail::Sendmail;
use MIME::Base64;
use MIME::QuotedPrint;
our $PROC = basename($0);
BEGIN {
use Exporter ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.0.0;
@ISA = qw(Exporter);
@EXPORT_OK = qw(&simple_send $error $log);
}
#=========================
our $error;
our $log;
our $boundary = "====" . time() . "====";
our $start_attachment = "–" . $boundary;
our $end_ALL_attachments = "–" . $boundary . ‘–’;
#=========================
sub _attach_file {
my ($mail, $filename) = @_;
my $FH;
my $mm = new File::MMagic;
my $content_type = $mm->checktype_filename($filename);
if ( open($FH, "< ", $filename) ) {
my $tmp_file = basename($filename);
my $mime_header =
$start_attachment
. "\\nContent-Type: $content_type; name=\\"$tmp_file\\"\\n"
. "Content-Transfer-Encoding: base64\\n"
. "Content-Disposition: attachment; filename=\\"$tmp_file\\"\\n";
$mail->{body} .=
$mime_header
. encode_base64(< $FH>)
. "\\n";
} else {
warn("Unable to attach file: $filename\\n");
}
return $mail;
}
sub _email_content_type {
my $mail = shift;
$mail->{‘content-type’} = "multipart/mixed; boundary=\\"$boundary\\"";
return %$mail;
}
sub _email_type {
my ($parms, $mail) = @_;
if ($parms->{‘options’}->{‘type’} && $parms->{‘options’}->{‘type’} =~ m/^html$/i ) {
my $mime_header =
$start_attachment
. "\\nContent-Type: text/html; charset=\\"iso-8859-1\\"\\n"
. "Content-Transfer-Encoding: quoted-printable\\n";
$mail->{‘body’} =
$mime_header
. "\\n"
. encode_qp($parms->{Body})
. "\\n";
} else {
my $mime_header =
$start_attachment
. "\\nContent-Type: text/plain; charset=\\"iso-8859-1\\"\\n"
. "Content-Transfer-Encoding: quoted-printable\\n";
$mail->{‘body’} =
$mime_header
. encode_qp($parms->{Body})
. "\\n";
}
return %$mail;
}
sub _email_file {
my ($parms, $mail) = @_;
if ($parms->{‘options’}->{‘files’}) {
if ( ref($parms->{‘options’}->{‘files’}) eq ‘ARRAY’) {
# We need to attach multiple files
foreach my $filename ( $parms->{‘options’}->{‘files’} ) {
$mail = _attach_file($mail, $filename);
}
} else {
# We need to attach a single file
$mail = _attach_file($mail, $parms->{‘options’}->{‘files’});
}
}
return %$mail;
}
sub _send_email {
my $parms = shift;
if ($parms && $parms->{To} && $parms->{Subject} && $parms->{Body} ) {
$parms->{From} = ’sis-dba@example.com’ unless $parms->{From};
my %mail = (
To => $parms->{To},
From => $parms->{From},
Subject => $parms->{Subject}
);
%mail = _email_content_type(\\%mail);
%mail = _email_type($parms, \\%mail);
%mail = _email_file($parms, \\%mail) if $parms->{‘options’}->{‘files’};
$mail{‘body’} .= $end_ALL_attachments;
if ( sendmail(%mail) ) {
return 1;
} else {
$error = $Mail::Sendmail::error;
$log = $Mail::Sendmail::log;
}
} else {
warn ("ERROR: dbS::EMail\\n");
warn ("\\t’To’ parameter is required\\n") unless $parms->{To};
warn ("\\t’Subject’ parameter is required\\n") unless $parms->{Subject};
warn ("\\t’Body’ parameter is required\\n") unless $parms->{Body};
}
}
sub simple_send {
my ($To, $Subject, $Body, $From, $options) = @_;
return _send_email( {
To => $To,
Subject => $Subject,
From => $From,
Body => $Body,
options => $options
} );
}
1;



Recent Comments