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


line stmt bran cond sub pod time code
1             package Email::Sender::Transport::Failable 1.500;
2             # ABSTRACT: a wrapper to makes things fail predictably
3              
4 2     2   1417 use Moo;
  2         4  
  2         10  
5             extends 'Email::Sender::Transport::Wrapper';
6              
7 2     2   523 use MooX::Types::MooseLike::Base qw(ArrayRef);
  2         6  
  2         566  
8              
9             #pod =head1 DESCRIPTION
10             #pod
11             #pod This transport extends L, meaning that it
12             #pod must be created with a C attribute of another
13             #pod Email::Sender::Transport. It will proxy all email sending to that transport,
14             #pod but only after first deciding if it should fail.
15             #pod
16             #pod It does this by calling each coderef in its C attribute,
17             #pod which must be an arrayref of code references. Each coderef will be called and
18             #pod will be passed the Failable transport, the Email::Abstract object, the
19             #pod envelope, and a reference to an array containing the rest of the arguments to
20             #pod C.
21             #pod
22             #pod If any coderef returns a true value, the value will be used to signal failure.
23             #pod
24             #pod =cut
25              
26             has 'failure_conditions' => (
27             isa => ArrayRef,
28             default => sub { [] },
29             is => 'ro',
30             reader => '_failure_conditions',
31             );
32              
33 2     2 0 3 sub failure_conditions { @{$_[0]->_failure_conditions} }
  2         8  
34 1     1 0 10 sub fail_if { push @{shift->_failure_conditions}, @_ }
  1         5  
35 0     0 0   sub clear_failure_conditions { @{$_[0]->{failure_conditions}} = () }
  0            
36              
37             around send_email => sub {
38             my ($orig, $self, $email, $env, @rest) = @_;
39              
40             for my $cond ($self->failure_conditions) {
41             my $reason = $cond->($self, $email, $env, \@rest);
42             next unless $reason;
43             die (ref $reason ? $reason : Email::Sender::Failure->new($reason));
44             }
45              
46             return $self->$orig($email, $env, @rest);
47             };
48              
49 2     2   13 no Moo;
  2         2  
  2         8  
50             1;
51              
52             __END__