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_rfc822, $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::fileparse( $_, 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( $stat_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', 'from@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;
}