File Coverage

blib/lib/Email/Sender/Simple.pm
Criterion Covered Total %
statement 77 88 87.5
branch 15 24 62.5
condition 3 7 42.8
subroutine 16 18 88.8
pod 0 6 0.0
total 111 143 77.6


line stmt bran cond sub pod time code
1             package Email::Sender::Simple 2.500;
2             # ABSTRACT: the simple interface for sending mail with Sender
3              
4 3     3   151661 use Moo;
  3         27384  
  3         19  
5             with 'Email::Sender::Role::CommonSending';
6              
7             #pod =head1 SEE INSTEAD
8             #pod
9             #pod For now, the best documentation of this class is in
10             #pod L.
11             #pod
12             #pod =cut
13              
14 3     3   6369 use Sub::Exporter::Util ();
  3         50775  
  3         177  
15 3         11 use Sub::Exporter -setup => {
16             exports => {
17             sendmail => Sub::Exporter::Util::curry_class('send'),
18             try_to_sendmail => Sub::Exporter::Util::curry_class('try_to_send'),
19             },
20 3     3   31 };
  3         7  
21              
22 3     3   3167 use Email::Address;
  3         86768  
  3         258  
23 3     3   1736 use Email::Sender::Transport;
  3         14  
  3         120  
24 3     3   1525 use Email::Sender::Util;
  3         11  
  3         96  
25 3     3   20 use Try::Tiny;
  3         7  
  3         2929  
26              
27             {
28             my $DEFAULT_TRANSPORT;
29             my $DEFAULT_FROM_ENV;
30              
31             sub _default_was_from_env {
32 1     1   3 my ($class) = @_;
33 1         4 $class->default_transport;
34 1         9 return $DEFAULT_FROM_ENV;
35             }
36              
37             sub transport_from_env {
38 2     2 0 25 my ($class, $env_base) = @_;
39 2   50     15 $env_base ||= 'EMAIL_SENDER_TRANSPORT';
40              
41 2         6 my $transport_class = $ENV{$env_base};
42 2 50 33     14 return unless defined $transport_class and length $transport_class;
43              
44 2         4 my %arg;
45 2         27 for my $key (grep { /^\Q$env_base\E_[_0-9A-Za-z]+$/ } keys %ENV) {
  72         226  
46 2         16 (my $new_key = $key) =~ s/^\Q$env_base\E_//;
47 2         10 $arg{lc $new_key} = $ENV{$key};
48             }
49              
50 2         19 return Email::Sender::Util->easy_transport($transport_class, \%arg);
51             }
52              
53             sub default_transport {
54 9 100   9 0 1656 return $DEFAULT_TRANSPORT if $DEFAULT_TRANSPORT;
55 2         6 my ($class) = @_;
56              
57 2         8 my $transport = $class->transport_from_env;
58              
59 2 50       166 if ($transport) {
60 2         5 $DEFAULT_FROM_ENV = 1;
61 2         5 $DEFAULT_TRANSPORT = $transport;
62             } else {
63 0         0 $DEFAULT_FROM_ENV = 0;
64 0         0 $DEFAULT_TRANSPORT = $class->build_default_transport;
65             }
66              
67 2         7 return $DEFAULT_TRANSPORT;
68             }
69              
70             sub build_default_transport {
71 0     0 0 0 require Email::Sender::Transport::Sendmail;
72 0         0 my $transport = eval { Email::Sender::Transport::Sendmail->new };
  0         0  
73              
74 0 0       0 return $transport if $transport;
75              
76 0         0 require Email::Sender::Transport::SMTP;
77 0         0 Email::Sender::Transport::SMTP->new;
78             }
79              
80             sub reset_default_transport {
81 0     0 0 0 undef $DEFAULT_TRANSPORT;
82 0         0 undef $DEFAULT_FROM_ENV;
83             }
84             }
85              
86             # Maybe this should be an around, but I'm just not excited about figuring out
87             # order at the moment. It just has to work. -- rjbs, 2009-06-05
88             around prepare_envelope => sub {
89             my ($orig, $class, $arg) = @_;
90             $arg ||= {};
91             my $env = $class->$orig($arg);
92              
93             $env = {
94             %$arg,
95             %$env,
96             };
97              
98             return $env;
99             };
100              
101             sub send_email {
102 6     6 0 63 my ($class, $email, $arg) = @_;
103              
104 6         24 my $transport = $class->default_transport;
105              
106 6 100       28 if ($arg->{transport}) {
107 1         5 $arg = { %$arg }; # So we can delete transport without ill effects.
108 1 50       5 $transport = delete $arg->{transport} unless $class->_default_was_from_env;
109             }
110              
111 6 50       35 Carp::confess("transport $transport not safe for use with Email::Sender::Simple")
112             unless $transport->is_simple;
113              
114 6         33 my ($to, $from) = $class->_get_to_from($email, $arg);
115              
116 6 100       55 Email::Sender::Failure::Permanent->throw("no recipients") if ! @$to;
117 4 50       14 Email::Sender::Failure::Permanent->throw("no sender") if ! defined $from;
118              
119 4         39 return $transport->send(
120             $email,
121             {
122             to => $to,
123             from => $from,
124             },
125             );
126             }
127              
128             sub try_to_send {
129 1     1 0 1565 my ($class, $email, $arg) = @_;
130              
131             try {
132 1     1   53 return $class->send($email, $arg);
133             } catch {
134 1   50 1   30 my $error = $_ || 'unknown error';
135 1 50       1281 return if try { $error->isa('Email::Sender::Failure') };
  1         34  
136 0         0 die $error;
137 1         11 };
138             }
139              
140             sub _get_to_from {
141 6     6   19 my ($class, $email, $arg) = @_;
142              
143 6         13 my $to = $arg->{to};
144 6 100       20 unless (@$to) {
145             my @to_addrs =
146 3         20 map { $_->address }
147 3         3429 grep { defined }
148 3         165 map { Email::Address->parse($_) }
149 5         13 map { $email->get_header($_) }
  10         494  
150             qw(to cc);
151 5         211 $to = \@to_addrs;
152             }
153              
154 6         19 my $from = $arg->{from};
155 6 50       21 unless (defined $from) {
156             ($from) =
157 4         15 map { $_->address }
158 4         313 grep { defined }
159 4         289 map { Email::Address->parse($_) }
160 6         14 map { $email->get_header($_) }
  6         28  
161             qw(from);
162             }
163              
164 6         121 return ($to, $from);
165             }
166              
167 3     3   26 no Moo;
  3         16  
  3         36  
168             "220 OK";
169              
170             __END__