Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Re: Net::SMTP with excel attachment

by atcroft (Monsignor)
on Jul 19, 2012 at 07:05 UTC ( #982594=note: print w/ replies, xml ) Need Help??


in reply to Net::SMTP with excel attachment

There may be better ways to do it, but I decided to pull out a script I used when testing a mail server and modify it to do what you described, within the restriction of trying not to use anything not listed as a core module. (Mostly I succeeded-the only exception would be if you require SMTP authentication, where you may need Authen::SASL and MIME::Base64.)

The script creates valid headers, a plain text component with a list of files attached, and attaches each file as a UUEncoded attachment. It also allows you to specify the outgoing mail server/port, your credentials for SMTP authentication, sender, subject, multiple recipient addresses, a test mode to see what the output will look like, and an SMTP debug option to allow you to watch the SMTP transaction.

use strict; use warnings; use File::Basename; use Getopt::Long; use Net::SMTP; $| = 1; my $LINEENDING = qq{\r\n}; my $tz_offset; { # Change this for your timezone - in my case, currently CDT (GMT-0500) my %tz_offset_part = ( neg => 1, hr => 5, min => 0, ); $tz_offset = ( $tz_offset_part{neg} * -1 ) * ( 3600 * $tz_offset_part{hr} + 60 * $tz_offset_part{min} ); } my %auth; my $debug = 0; my $test = 0; my @to_address; my $from_address; my $subject = q{test message}; my $mail_server = q{localhost}; if ( scalar( grep( /^-/, @ARGV ) ) ) { my ($local_host); GetOptions( 'address:s' => \@to_address, 'sender:s' => \$from_address, 'server:s' => \$mail_server, 'un:s' => \$auth{un}, 'pw:s' => \$auth{pw}, 'debug+' => \$debug, 'test+' => \$test, 'withsubject:s' => \$subject, 'help' => \&help, ); @to_address = split( /,/, join( ',', @to_address ) ); if ( !$test ) { &help if ( !scalar(@to_address) ); &help if ( ( !defined($from_address) ) or ( !length($from_address) ) ); } } else { &help; } my $id; my $date_rfc822; my $boundary; { my $t = time; $id = gen_id( $t, $from_address ); $date_rfc822 = lt_2_rfc822( $tz_offset, $t ); $boundary = sprintf q{_%05d_%s}, $$, $id; } my @msg; # Add To, From, Message-ID, Date, Subject, and Content-Type headers push @msg, sprintf <<HEADER, join( q{, }, @to_address ), $from_address, $id, $date_rfc8 +22, $subject, $boundary; To: %s From: %s Message-Id: %s Date: %s Subject: %s Content-Type: multipart/mixed;\n\tboundary="%s" HEADER # Add basic message telling what was included push @msg, sprintf <<INDEX, $boundary, join( qq{\n}, map { my $bfn = File::Basename::fi +leparse( $_, qq{} ); qq{\t} . $bfn; } sort { $a cmp $b } @ARGV ); --%s Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: quoted-printable The following files are attached: %s INDEX my @attachments; foreach my $fn ( sort { $a cmp $b } @ARGV ) { my $bfn = File::Basename::fileparse( $fn, q{}, ); { my @stat_info = stat($fn); if ( $stat_info[9] < $stat_info[10] ) { @stat_info[ 9 .. 10 ] = @stat_info[ 10, 9 ]; } my $str; { local $/ = undef; open my $DF, $fn or die $!; binmode $DF; my $fc = <$DF>; close $DF; $str = pack "u", $fc; } chomp $str; $str = sprintf <<ATTACHMENT, $boundary, $bfn, $bfn, $bfn, gt_2_rfc822( $sta +t_info[10] ), gt_2_rfc822( $stat_info[9] ), $bfn, $str; --%s Content-Type: application/octet-stream; name="%s" Content-Description: %s Content-Transfer-Encoding: uuencode Content-Disposition: attachment; filename="%s"; creation-date="%s"; modification-date="%s" begin 0600 %s %s ` end ATTACHMENT push @msg, $str; } } push @msg, qq{--} . $boundary . qq{--} . $LINEENDING; push @msg, qq{} . $LINEENDING; if ($test) { foreach (@msg) { print $_, qq{\n}; } } else { my $port = 25; if ( $mail_server =~ m/:/ ) { ( $mail_server, $port ) = split /:/, $mail_server, 2; } my $smtp = Net::SMTP->new( $mail_server, Debug => $debug, Port => $port, ) or die $!; my $dont_continue = 0; if ( defined $auth{un} ) { $smtp->auth( $auth{un}, $auth{pw} ) or $dont_continue++; } if ( !$dont_continue ) { $smtp->mail($from_address) or die $!; foreach (@to_address) { last if ($dont_continue); $smtp->to($_) or $dont_continue++; } } if ( !$dont_continue ) { $smtp->data() or $dont_continue++; foreach (@msg) { last if ($dont_continue); my $str = $_ . $LINEENDING; $smtp->datasend($_) or $dont_continue++; } if ( !$dont_continue ) { $smtp->dataend() or $dont_continue++; } } $smtp->quit; } # # Subroutines # sub help { printf <<HELPTEXT, $0, 'to@address', 'to@address', 'from@address', 'fro +m@address'; %s [-address %s] [-sender %s] [-server smtp.server.to.use[:port]] [-withsubject "subjectline to use"] [-un un] [-pw pw] [-debug] [-test] [-help] file1 file2 ... fileN -address %s - address to test to -sender %s - address to send from -server - use as mailserver - otherwise, use localhost -withsubject - string to use as subject line -un %s - SMTP authentication user name -pw %s - SMTP authentication password -debug - enable debugging information for SMTP transaction -test - do not send message, but display what would be sent -help - display this help text file1 ... fileN - files to attach to message HELPTEXT exit; } sub gen_id { my ( $t, $fa ) = @_; my @lt = localtime $t; my @address_parts = split /\@/, $fa; $id = sprintf( "%4d%02d%02d%02d%02d%02d.%s@%s", $lt[5] + 1900, $lt[4] + 1, reverse( @lt[ 0 .. 3 ] ), crypt( scalar localtime $t, sprintf( "%02d", $lt[0] ) ), $address_parts[1] ); } sub gt_2_rfc822 { my ($t) = @_; my @gt = gmtime $t; my $str = sprintf q{%s, %02d %s %04d %02d:%02d:%02d GMT}, (qw(Sun Mon Tue Wed Thu Fri Sat))[ $gt[6] ], $gt[3], (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)) [ $gt[4] ], $gt[5] + 1900, reverse( @gt[ 0 .. 2 ] ); return $str; } sub lt_2_rfc822 { my ( $tz_off, $t ) = @_; my @lt = localtime $t; my $str = sprintf( q{%s, %02d %s %04d %02d:%02d:%02d %05d}, (qw(Sun Mon Tue Wed Thu Fri Sat))[ $lt[6] ], $lt[3], (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)) [ $lt[4] ], $lt[5] + 1900, reverse( @lt[ 0 .. 2 ] ), ( $tz_off / 3600 ) * 100 + ( ( $tz_off % 3600 ) / 60 ) ); return $str; }

Hope that helps.


Comment on Re: Net::SMTP with excel attachment
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://982594]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (8)
As of 2015-07-04 02:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (57 votes), past polls