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.