File Coverage

blib/lib/Email/Sender/Simple.pm
Criterion Covered Total %
statement 75 86 87.2
branch 15 24 62.5
condition 3 7 42.8
subroutine 16 18 88.8
pod 0 6 0.0
total 109 141 77.3


line stmt bran cond sub pod time code
1             package Email::Sender::Simple 2.601;
2             # ABSTRACT: the simple interface for sending mail with Sender
3              
4 3     3   225376 use Moo;
  3         19296  
  3         17  
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   6126 use Sub::Exporter::Util ();
  3         57071  
  3         173  
15 3         9 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   22 };
  3         5  
21              
22 3     3   2848 use Email::Address::XS;
  3         10431  
  3         147  
23 3     3   1292 use Email::Sender::Transport;
  3         14  
  3         129  
24 3     3   1528 use Email::Sender::Util;
  3         11  
  3         109  
25 3     3   19 use Try::Tiny;
  3         20  
  3         3393  
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         3 $class->default_transport;
34 1         6 return $DEFAULT_FROM_ENV;
35             }
36              
37             sub transport_from_env {
38 2     2 0 5 my ($class, $env_base) = @_;
39 2   50     13 $env_base ||= 'EMAIL_SENDER_TRANSPORT';
40              
41 2         9 my $transport_class = $ENV{$env_base};
42 2 50 33     13 return unless defined $transport_class and length $transport_class;
43              
44 2         4 my %arg;
45 2         41 for my $key (grep { /^\Q$env_base\E_[_0-9A-Za-z]+$/ } keys %ENV) {
  58         234  
46 2         11 (my $new_key = $key) =~ s/^\Q$env_base\E_//;
47 2         9 $arg{lc $new_key} = $ENV{$key};
48             }
49              
50 2         24 return Email::Sender::Util->easy_transport($transport_class, \%arg);
51             }
52              
53             sub default_transport {
54 9 100   9 0 1579 return $DEFAULT_TRANSPORT if $DEFAULT_TRANSPORT;
55 2         4 my ($class) = @_;
56              
57 2         8 my $transport = $class->transport_from_env;
58              
59 2 50       138 if ($transport) {
60 2         4 $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 18 my ($class, $email, $arg) = @_;
103              
104 6         21 my $transport = $class->default_transport;
105              
106 6 100       21 if ($arg->{transport}) {
107 1         6 $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       30 Carp::confess("transport $transport not safe for use with Email::Sender::Simple")
112             unless $transport->is_simple;
113              
114 6         28 my ($to, $from) = $class->_get_to_from($email, $arg);
115              
116 6 100       54 Email::Sender::Failure::Permanent->throw("no recipients") if ! @$to;
117 4 50       25 Email::Sender::Failure::Permanent->throw("no sender") if ! defined $from;
118              
119 4         44 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 1322 my ($class, $email, $arg) = @_;
130              
131             try {
132 1     1   63 return $class->send($email, $arg);
133             } catch {
134 1   50 1   22 my $error = $_ || 'unknown error';
135 1 50       1570 return if try { $error->isa('Email::Sender::Failure') };
  1         71  
136 0         0 die $error;
137 1         13 };
138             }
139              
140             sub _get_to_from {
141 6     6   14 my ($class, $email, $arg) = @_;
142              
143 6         13 my $to = $arg->{to};
144 6 100       15 unless (@$to) {
145             my @to_addrs =
146 3         108 map { $_->address }
147 3         147 map { Email::Address::XS->parse($_) }
148 5         14 map { $email->get_header($_) }
  10         498  
149             qw(to cc);
150 5         279 $to = \@to_addrs;
151             }
152              
153 6         14 my $from = $arg->{from};
154 6 50       20 unless (defined $from) {
155             ($from) =
156 4         119 map { $_->address }
157 4         227 map { Email::Address::XS->parse($_) }
158 6         12 map { $email->get_header($_) }
  6         18  
159             qw(from);
160             }
161              
162 6         261 return ($to, $from);
163             }
164              
165 3     3   26 no Moo;
  3         8  
  3         28  
166             "220 OK";
167              
168             __END__