Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
Think about Loose Coupling
 
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 making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2014-04-19 13:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (480 votes), past polls