Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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.


In reply to Re: Net::SMTP with excel attachment by atcroft
in thread Net::SMTP with excel attachment by norricorp

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (9)
As of 2024-03-28 12:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found