File Coverage

blib/lib/Mojar/Message/Smtp.pm

Criterion	Covered	Total	%
statement	18	80	22.5
branch	0	30	0.0
condition	0	22	0.0
subroutine	6	19	31.5
pod	2	10	20.0
total	26	161	16.1

package Mojar::Message::Smtp;
use Mojo::Base -base;

our $VERSION = 0.041;

use Carp ();
use MIME::Entity;
use Mojar::Cron::Util 'tz_offset';
use Mojar::Log;
use POSIX 'strftime';

# Attributes

# Protocol
has ssl => 0;
has host => '127.0.0.1';
has port => sub { shift->ssl ? 465 : 25 };
has [qw(user secret agent)];  # SASL username, password
has domain => 'localhost.localdomain';  # for helo handshake
has timeout => 120;
has debug => 1;
#TODO: set 'debug => 0' before first CPAN release
has date_pattern => '%a, %d %b %Y %H:%M:%S';

# Message
has From => sub { ($ENV{USER} // $ENV{USERNAME} // '_') .'@'. shift->domain };
has [qw(To Cc Bcc attachments)];
has [qw(Subject body)] => '';
has Type => 'text/plain';

sub headers {
  my $self = shift;
  return $self->set(@_) if @_;
  map +($_ => $self->{$_}), grep +(/^[A-Z]/), keys %$self  # Titlecase fields
}
sub param {
  my $self = shift;
  return $self->set(@_) if @_;
  return (
    Host => $self->agent // $self->host,
    Port => $self->port,
    Hello => $self->domain,
    Debug => $self->debug,
    Timeout => $self->timeout
  );
}

has log => sub { Mojar::Log->new };

# Public methods

sub attach {
  my ($self, %param) = @_;
  my $fail = sub { $self->fail('Failed to attach', @_) };
  %param = (
    Disposition => 'attachment',
    Encoding => '-SUGGEST',
    %param  # override defaults
  );
  if (exists $param{Path} and my $file = $param{Path}) {
    $fail->('Failed to find attachment') unless -f $file or -l $file;
    $fail->('Failed to read attachment') unless -r $file;
  }
  push @{ $self->{attachments} //= [] }, \%param;

  return $self;
}

sub set {
  my ($self, %param) = @_;
  %$self = (%$self, %param);
  return $self;
}

sub reset {
  my $self = shift;
  delete @$self{ grep +(/^[A-Z]/), keys %$self };  # Titlecase fields
  delete @$self{'body', 'attachments'};
  return $self;
}

sub connect {
  my ($self, %param) = @_;
  my $fail = sub { $self->fail('Failed to connect', @_) };

#TODO: consider testing/reusing existing agent
  $self->disconnect if $self->agent;

  my $class = $self->ssl ? 'Net::SMTP::SSL' : 'Net::SMTP';
  (my $file = $class) =~ s{::}{/}g;
  require "${file}.pm" or $fail->("Failed to load $class", $!);
  my $agent = $class->new($self->param(%param))
    or $self->fail('Connection rejected', $!);

  if ($self->user) {
    $fail->('Missing required auth secret') unless defined $self->secret;
    unless ($agent->auth($self->user, $self->secret)) {
      my $msg = $agent->message // '';
      $fail->('Missing MIME::Base64 (AUTH)') if $msg =~ /MIME::Base64/;
      $fail->('Missing Authen::SASL (AUTH)') if $msg =~ /Authen::SASL/;
      $fail->("Failed authentication\n$!\n$msg");
    }
  }
  return $self->agent($agent);
}

sub disconnect {
  my ($self, %param) = @_;
  $_ and $_->quit for delete $self->{agent};
  return $self;
}

sub send {
  my ($self, %param) = @_;
  my $fail = sub { $self->fail('Failed to send', @_) };

  $self->{Date} = $self->date;
  $self->{Sender} //= $self->{From};
  $self->{'X-Mailer'} //= "Mojar::Message::Smtp/$VERSION";

  my $mime;
  if ($self->attachments) {
    $mime = MIME::Entity->build(
      Type => 'multipart/mixed',
      $self->headers
    );
    $mime->attach(
      Type        => $self->Type,
      Disposition => 'inline',
      Encoding    => '-SUGGEST',
      Data        => $self->body
    );
    $mime->attach(%$_) for @{$self->attachments};
  }
  else {
    $mime = MIME::Entity->build(
      Type        => $self->Type,
      Disposition => 'inline',
      Encoding    => '-SUGGEST',
      $self->headers,
      Data        => $self->body
    );
  }

  my @sent = $mime->smtpsend($self->param, MailFrom => $self->From, %param);
  $self->log->info(sprintf 'Sent email to %s', join q{,}, @sent);
  return $self;
}

sub date { strftime($_[0]->date_pattern, localtime) .' '. tz_offset }

sub fail {
  my $self = shift;
  $self->log->error($_) for @_;
  Carp::croak(join("\n", @_) ."\n");
}

1;
__END__