File Coverage

blib/lib/Email/Sender/Simple.pm

Criterion	Covered	Total	%
statement	75	86	87.2
branch	15	24	62.5
condition	3	7	42.8
subroutine	16	18	88.8
pod	0	6	0.0
total	109	141	77.3

package Email::Sender::Simple 2.600;
# ABSTRACT: the simple interface for sending mail with Sender

use Moo;
with 'Email::Sender::Role::CommonSending';

#pod =head1 SEE INSTEAD
#pod
#pod For now, the best documentation of this class is in
#pod L.
#pod
#pod =cut

use Sub::Exporter::Util ();
use Sub::Exporter -setup => {
  exports => {
    sendmail        => Sub::Exporter::Util::curry_class('send'),
    try_to_sendmail => Sub::Exporter::Util::curry_class('try_to_send'),
  },
};

use Email::Address::XS;
use Email::Sender::Transport;
use Email::Sender::Util;
use Try::Tiny;

{
  my $DEFAULT_TRANSPORT;
  my $DEFAULT_FROM_ENV;

  sub _default_was_from_env {
    my ($class) = @_;
    $class->default_transport;
    return $DEFAULT_FROM_ENV;
  }

  sub transport_from_env {
    my ($class, $env_base) = @_;
    $env_base ||= 'EMAIL_SENDER_TRANSPORT';

    my $transport_class = $ENV{$env_base};
    return unless defined $transport_class and length $transport_class;

    my %arg;
    for my $key (grep { /^\Q$env_base\E_[_0-9A-Za-z]+$/ } keys %ENV) {
      (my $new_key = $key) =~ s/^\Q$env_base\E_//;
      $arg{lc $new_key} = $ENV{$key};
    }

    return Email::Sender::Util->easy_transport($transport_class, \%arg);
  }

  sub default_transport {
    return $DEFAULT_TRANSPORT if $DEFAULT_TRANSPORT;
    my ($class) = @_;

    my $transport = $class->transport_from_env;

    if ($transport) {
      $DEFAULT_FROM_ENV  = 1;
      $DEFAULT_TRANSPORT = $transport;
    } else {
      $DEFAULT_FROM_ENV  = 0;
      $DEFAULT_TRANSPORT = $class->build_default_transport;
    }

    return $DEFAULT_TRANSPORT;
  }

  sub build_default_transport {
    require Email::Sender::Transport::Sendmail;
    my $transport = eval { Email::Sender::Transport::Sendmail->new };

    return $transport if $transport;

    require Email::Sender::Transport::SMTP;
    Email::Sender::Transport::SMTP->new;
  }

  sub reset_default_transport {
    undef $DEFAULT_TRANSPORT;
    undef $DEFAULT_FROM_ENV;
  }
}

# Maybe this should be an around, but I'm just not excited about figuring out
# order at the moment.  It just has to work. -- rjbs, 2009-06-05
around prepare_envelope => sub {
  my ($orig, $class, $arg) = @_;
  $arg ||= {};
  my $env = $class->$orig($arg);

  $env = {
    %$arg,
    %$env,
  };

  return $env;
};

sub send_email {
  my ($class, $email, $arg) = @_;

  my $transport = $class->default_transport;

  if ($arg->{transport}) {
    $arg = { %$arg }; # So we can delete transport without ill effects.
    $transport = delete $arg->{transport} unless $class->_default_was_from_env;
  }

  Carp::confess("transport $transport not safe for use with Email::Sender::Simple")
    unless $transport->is_simple;

  my ($to, $from) = $class->_get_to_from($email, $arg);

  Email::Sender::Failure::Permanent->throw("no recipients") if ! @$to;
  Email::Sender::Failure::Permanent->throw("no sender") if ! defined $from;

  return $transport->send(
    $email,
    {
      to   => $to,
      from => $from,
    },
  );
}

sub try_to_send {
  my ($class, $email, $arg) = @_;

  try {
    return $class->send($email, $arg);
  } catch {
    my $error = $_ || 'unknown error';
    return if try { $error->isa('Email::Sender::Failure') };
    die $error;
  };
}

sub _get_to_from {
  my ($class, $email, $arg) = @_;

  my $to = $arg->{to};
  unless (@$to) {
    my @to_addrs =
      map  { $_->address                   }
      map  { Email::Address::XS->parse($_) }
      map  { $email->get_header($_)        }
      qw(to cc);
    $to = \@to_addrs;
  }

  my $from = $arg->{from};
  unless (defined $from) {
    ($from) =
      map  { $_->address                   }
      map  { Email::Address::XS->parse($_) }
      map  { $email->get_header($_)        }
      qw(from);
  }

  return ($to, $from);
}

no Moo;
"220 OK";

__END__