/usr/share/perl5/Email/Sender/Transport/Failable.pm is in libemail-sender-perl 1.300031-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | package Email::Sender::Transport::Failable;
# ABSTRACT: a wrapper to makes things fail predictably
$Email::Sender::Transport::Failable::VERSION = '1.300031';
use Moo;
extends 'Email::Sender::Transport::Wrapper';
use MooX::Types::MooseLike::Base qw(ArrayRef);
#pod =head1 DESCRIPTION
#pod
#pod This transport extends L<Email::Sender::Transport::Wrapper>, meaning that it
#pod must be created with a C<transport> 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<failure_conditions> 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<send>.
#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__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Failable - a wrapper to makes things fail predictably
=head1 VERSION
version 1.300031
=head1 DESCRIPTION
This transport extends L<Email::Sender::Transport::Wrapper>, meaning that it
must be created with a C<transport> attribute of another
Email::Sender::Transport. It will proxy all email sending to that transport,
but only after first deciding if it should fail.
It does this by calling each coderef in its C<failure_conditions> attribute,
which must be an arrayref of code references. Each coderef will be called and
will be passed the Failable transport, the Email::Abstract object, the
envelope, and a reference to an array containing the rest of the arguments to
C<send>.
If any coderef returns a true value, the value will be used to signal failure.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|