File Coverage

blib/lib/Email/Send/SMTP.pm

Criterion	Covered	Total	%
statement	19	74	25.6
branch	3	40	7.5
condition	0	11	0.0
subroutine	5	8	62.5
pod	0	4	0.0
total	27	137	19.7

package Email::Send::SMTP;
use strict;

use vars qw[$VERSION];
use Email::Address 1.80;
BEGIN {
  local $Return::Value::NO_CLUCK = 1;
  require Return::Value;
  Return::Value->import;
}

$VERSION = '2.199';

sub is_available {
    my ($class, %args) = @_;
    my $success = 1;
    $success = eval { require Net::SMTP };
    $success = eval { require Net::SMTP::SSL } if $args{ssl};
    $success = eval { require Net::SMTP::TLS } if $args{tls};
    return   $success
           ? success
           : failure $@;
}

sub get_env_sender {
  my ($class, $message) = @_;

  return unless my $hdr = $message->header('From');
  my $from = (Email::Address->parse($hdr))[0]->address;
}

sub get_env_recipients {
  my ($class, $message) = @_;

  my %to = map  { $_->address => 1 }
           map  { Email::Address->parse($_) }
           grep { defined and length }
           map  { $message->header($_) }
           qw(To Cc Bcc);

  return keys %to;
}

sub send {
    my ($class, $message, @args) = @_;

    my %args;
    if ( @args % 2 ) {
        my $host = shift @args;
        %args = @args;
        $args{Host} = $host;
    } else {
        %args = @args;
    }

    my $host = delete($args{Host}) || 'localhost';

    my $smtp_class = $args{ssl} ? 'Net::SMTP::SSL'
                   : $args{tls} ? 'Net::SMTP::TLS'
                   :              'Net::SMTP';

    eval "require $smtp_class; 1" or die;

    if ( $smtp_class eq 'Net::SMTP::TLS' ) {
        # ::TLS has different User/Password than the rest
        $args{User}     ||= $args{username};
        $args{Password} ||= $args{password};
    }

    my $SMTP = $smtp_class->new($host, %args);
    return failure "Couldn't connect to $host" unless $SMTP;

    my ($user, $pass) = @args{qw[username password]};

    # for ::TLS, the auth is done by the new()
    if ( $user and not $smtp_class eq 'Net::SMTP::TLS'  ) {
        $SMTP->auth($user, $pass)
          or return failure "Couldn't authenticate '$user:...'";
    }

    my @bad;
    eval {
        my $from = $class->get_env_sender($message);

        # ::TLS has no useful return value, but will croak on failure.
        eval { $SMTP->mail($from); 1 } or return failure "FROM: <$from> denied";

        my @to = $class->get_env_recipients($message);

        if (eval { $SMTP->isa('Net::SMTP::TLS') }) {
          $SMTP->to(@to);
        } else {
          my @ok = $SMTP->to(@to, { SkipBad => 1 });

          if ( @to != @ok ) {
              my %to; @to{@to} = (1) x @to;
              delete @to{@ok};
              @bad = keys %to;
          }
        }

        return failure "No valid recipients" if @bad == @to;
    };

    return failure $@ if $@;

    if ( $smtp_class eq 'Net::SMTP::TLS' ) {
        $SMTP->data;
        $SMTP->datasend( $message->as_string );
        $SMTP->dataend;
    }
    else {
        return failure "Can't send data" unless $SMTP->data( $message->as_string );
    }

    $SMTP->quit;
    return success "Message sent", prop => { bad => [ @bad ], };
}

1;

__END__