File Coverage

blib/lib/Email/Sender/Transport/Failable.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	6	83.3
pod	0	3	0.0
total	18	24	75.0

package Email::Sender::Transport::Failable 1.500;
# ABSTRACT: a wrapper to makes things fail predictably

use Moo;
extends 'Email::Sender::Transport::Wrapper';

use MooX::Types::MooseLike::Base qw(ArrayRef);

#pod =head1 DESCRIPTION
#pod
#pod This transport extends L, meaning that it
#pod must be created with a C attribute of another
#pod Email::Sender::Transport.  It will proxy all email sending to that transport,
#pod but only after first deciding if it should fail.
#pod
#pod It does this by calling each coderef in its C attribute,
#pod which must be an arrayref of code references.  Each coderef will be called and
#pod will be passed the Failable transport, the Email::Abstract object, the
#pod envelope, and a reference to an array containing the rest of the arguments to
#pod C.
#pod
#pod If any coderef returns a true value, the value will be used to signal failure.
#pod
#pod =cut

has 'failure_conditions' => (
  isa => ArrayRef,
  default => sub { [] },
  is      => 'ro',
  reader  => '_failure_conditions',
);

sub failure_conditions { @{$_[0]->_failure_conditions} }
sub fail_if { push @{shift->_failure_conditions}, @_ }
sub clear_failure_conditions { @{$_[0]->{failure_conditions}} = () }

around send_email => sub {
  my ($orig, $self, $email, $env, @rest) = @_;

  for my $cond ($self->failure_conditions) {
    my $reason = $cond->($self, $email, $env, \@rest);
    next unless $reason;
    die (ref $reason ? $reason : Email::Sender::Failure->new($reason));
  }

  return $self->$orig($email, $env, @rest);
};

no Moo;
1;

__END__