File Coverage

blib/lib/Email/Sender/Transport/Mailgun.pm
Criterion Covered Total %
statement 58 58 100.0
branch 9 10 90.0
condition 6 6 100.0
subroutine 15 15 100.0
pod 0 3 0.0
total 88 92 95.6


line stmt bran cond sub pod time code
1             our $VERSION = "0.04";
2              
3             use Moo;
4 6     6   887675 with 'Email::Sender::Transport';
  6         50870  
  6         24  
5              
6             use HTTP::Tiny qw( );
7 6     6   10893 use HTTP::Tiny::Multipart qw( );
  6         207784  
  6         162  
8 6     6   2185 use JSON::MaybeXS qw( );
  6         10454  
  6         152  
9 6     6   1811 use MooX::Types::MooseLike::Base qw( ArrayRef Enum Str);
  6         29071  
  6         158  
10 6     6   2493  
  6         32624  
  6         514  
11             {
12             package
13             Email::Sender::Success::MailgunSuccess;
14             use Moo;
15 6     6   44 extends 'Email::Sender::Success';
  6         9  
  6         41  
16             has id => (
17             is => 'ro',
18             required => 1,
19             );
20             no Moo;
21 6     6   1972 }
  6         13  
  6         28  
22              
23             has [qw( api_key domain )] => (
24             is => 'ro',
25             required => 1,
26             isa => Str,
27             );
28              
29             has [qw( tag )] => (
30             is => 'ro',
31             predicate => 1,
32             isa => ArrayRef[Str],
33             coerce => sub { ref $_[0] ? $_[0] : [ split(/,\s*/, $_[0]) ] },
34             );
35              
36             has deliverytime => (
37             is => 'ro',
38             predicate => 1,
39             isa => Str,
40             coerce => sub {
41             ref $_[0] eq 'DateTime'
42             ? $_[0]->strftime('%a, %d %b %Y %H:%M:%S %z') : $_[0]
43             },
44             );
45              
46             has [qw( dkim testmode tracking tracking_opens )] => (
47             is => 'ro',
48             predicate => 1,
49             isa => Enum[qw( yes no )],
50             );
51              
52             has tracking_clicks => (
53             is => 'ro',
54             predicate => 1,
55             isa => Enum[qw( yes no htmlonly )],
56             );
57              
58             has region => (
59             is => 'ro',
60             predicate => 1,
61             isa => Enum[qw( us eu )],
62             );
63              
64             has base_uri => (
65             is => 'lazy',
66             builder => sub { 'https://api.mailgun.net/v3' },
67 6     6   68 );
68              
69             has uri => (
70             is => 'lazy',
71             );
72              
73             has ua => (
74             is => 'lazy',
75             builder => sub { HTTP::Tiny->new(verify_SSL => 1) },
76 2     2   25 );
77              
78             has json => (
79             is => 'lazy',
80             builder => sub { JSON::MaybeXS->new },
81 2     2   27 );
82              
83             # https://documentation.mailgun.com/en/latest/api-sending.html#sending
84             my ($self, $email, $env) = @_;
85              
86 4     4 0 20304 my $content = {
87             to => ref $env->{to} ? join(',', @{ $env->{to} }) : $env->{to},
88             message => {
89 4         20 filename => 'message.mime',
90 4 50       13 content => $email->as_string,
91             },
92             };
93              
94             my @options = qw(
95             deliverytime dkim tag testmode tracking tracking_clicks tracking_opens
96 4         331 );
97              
98             for my $option (@options) {
99             my $has_option = "has_$option";
100 4         10 if ($self->$has_option) {
101 28         42 my $key = "o:$option";
102 28 100       76 $key =~ tr/_/-/;
103 3         5 $content->{$key} = $self->$option;
104 3         6 }
105 3         9 }
106              
107             my $uri = $self->uri . '/messages.mime';
108             my $response = $self->ua->post_multipart($uri, $content);
109 4         83  
110 4         73 $self->failure($response, $env->{to})
111             unless $response->{success};
112              
113 4 100       1137 return $self->success($response);
114             }
115 1         5  
116             my ($self, $response) = @_;
117              
118             my $content = $self->json->decode($response->{content});
119 1     1 0 3 return Email::Sender::Success::MailgunSuccess->new(id => $content->{id});
120             }
121 1         19  
122 1         24 my ($self, $response, $recipients) = @_;
123              
124             # Most errors have { message => $message } in the content, some, such as
125             # an auth error, have just a plain string.
126 3     3 0 6 my $content = eval { $self->json->decode($response->{content}) };
127             my $message = $content && $content->{message}
128             ? $content->{message} : $response->{content};
129              
130 3         5 Email::Sender::Failure->throw({
  3         55  
131             message => $message,
132 3 100 100     59 recipients => $recipients,
133             });
134 3         20 }
135              
136             my $self = shift;
137              
138             my ($proto, $rest) = split('://', $self->base_uri);
139             my $domain = $self->domain;
140              
141 7     7   10266 # Percent-escape anything other than alphanumeric and - _ . ~
142             # https://github.com/sdt/Email-Sender-Transport-Mailgun/issues/4
143 7         106 my $api_key = $self->api_key;
144 7         38 $api_key =~ s/[^-_.~0-9a-zA-Z]/sprintf('%%%02x',ord($&))/eg;
145              
146             # adapt endpoint based on region setting.
147             $rest =~ s/(\.mailgun)/sprintf('.%s%s', $self->region, $1)/e
148 7         17 if defined $self->region && $self->region ne 'us';
149 7         18  
  5         17  
150             return "$proto://api:$api_key\@$rest/$domain";
151             }
152 7 100 100     40  
  1         7  
153             no Moo;
154             1;
155 7         37  
156             =encoding utf-8
157              
158 6     6   5689 =for stopwords deliverytime dkim hardcode mailouts prepend templated testmode
  6         12  
  6         357  
159              
160             =head1 NAME
161              
162             Email::Sender::Transport::Mailgun - Mailgun transport for Email::Sender
163              
164             =head1 SYNOPSIS
165              
166             use Email::Sender::Simple qw( sendmail );
167             use Email::Sender::Transport::Mailgun qw( );
168              
169             my $transport = Email::Sender::Transport::Mailgun->new(
170             api_key => '...',
171             domain => '...',
172             );
173              
174             my $message = ...;
175              
176             sendmail($message, { transport => $transport });
177              
178             =head1 DESCRIPTION
179              
180             This transport delivers mail via Mailgun's messages.mime API.
181              
182             =head2 Why use this module?
183              
184             The SMTP transport can also be used to send messages through Mailgun. In this
185             case, Mailgun options must be specified with Mailgun-specific MIME headers.
186              
187             This module exposes those options as attributes, which can be set in code, or
188             via C<EMAIL_SENDER_TRANSPORT_> environment variables.
189              
190             =head2 Why not use this module?
191              
192             This module uses Mailgun's messages.mime API, not the full-blown messages API.
193              
194             If you want to use advanced Mailgun features such as templated batch mailouts
195             or mailing lists, you're better off using something like L<WebService::Mailgun>
196             or L<WWW::Mailgun>.
197              
198             =head1 REQUIRED ATTRIBUTES
199              
200             The attributes all correspond directly to Mailgun parameters.
201              
202             =head2 api_key
203              
204             Mailgun API key. See L<https://documentation.mailgun.com/en/latest/api-intro.html#authentication-1>
205              
206             =head2 domain
207              
208             Mailgun domain. See L<https://documentation.mailgun.com/en/latest/api-intro.html#base-url-1>
209              
210             =head1 OPTIONAL ATTRIBUTES
211              
212             These (except region) correspond to the C<o:> options in the C<messages.mime>
213             section of L<https://documentation.mailgun.com/en/latest/api-sending.html#sending>
214              
215             =head2 deliverytime
216              
217             Desired time of delivery. String or DateTime object.
218              
219             =head2 dkim
220              
221             Enables/disables DKIM signatures. C<'yes'> or C<'no'>.
222              
223             =head2 region
224              
225             Defines used Mailgun region. C<'us'> (default) or C<'eu'>.
226              
227             See L<https://documentation.mailgun.com/en/latest/api-intro.html#mailgun-regions-1>
228              
229             =head2 tag
230              
231             Tag string. Comma-separated string list or arrayref of strings.
232              
233             =head2 testmode
234              
235             Enables sending in test mode. C<'yes'> or C<'no'>.
236              
237             =head2 tracking
238              
239             Toggles tracking. C<'yes'> or C<'no'>.
240              
241             =head2 tracking_clicks
242              
243             Toggles clicks tracking. C<'yes'>, C<'no'> or C<'html_only'>.
244              
245             =head2 tracking_opens
246              
247             Toggles open tracking. C<'yes'> or C<'no'>.
248              
249             =head1 MIME HEADERS
250              
251             The C<o:> options above can also be specified using the C<X-Mailgun-> headers
252             listed here L<https://documentation.mailgun.com/en/latest/user_manual.html#sending-via-smtp>
253              
254             If a single-valued option is specified in both the options and the headers,
255             experimentation shows the header takes precedence. This doesn't seem to be
256             documented, so don't rely on this behaviour.
257              
258             Multi-valued options use both the options and the headers.
259              
260             =head1 ENVIRONMENT
261              
262             The great strength of Email::Sender is that you don't need to hardcode your
263             transport, nor any of the options relating to that transport. They can all be
264             specified via environment variables.
265              
266             To select the Mailgun transport, use C<EMAIL_SENDER_TRANSPORT=Mailgun>.
267              
268             To specify any of the attributes above, prepend the attribute name with
269             C<EMAIL_SENDER_TRANSPORT_>.
270              
271             =over
272              
273             =item EMAIL_SENDER_TRANSPORT_api_key
274              
275             =item EMAIL_SENDER_TRANSPORT_domain
276              
277             =item EMAIL_SENDER_TRANSPORT_deliverytime
278              
279             =item EMAIL_SENDER_TRANSPORT_dkim
280              
281             =item EMAIL_SENDER_TRANSPORT_region
282              
283             =item EMAIL_SENDER_TRANSPORT_tag
284              
285             =item EMAIL_SENDER_TRANSPORT_testmode
286              
287             =item EMAIL_SENDER_TRANSPORT_tracking
288              
289             =item EMAIL_SENDER_TRANSPORT_tracking_clicks
290              
291             =item EMAIL_SENDER_TRANSPORT_tracking_opens
292              
293             =back
294              
295             =head1 LICENSE
296              
297             Copyright (C) Stephen Thirlwall.
298              
299             This library is free software; you can redistribute it and/or modify
300             it under the same terms as Perl itself.
301              
302             =head1 AUTHOR
303              
304             Stephen Thirlwall E<lt>sdt@cpan.orgE<gt>
305              
306             =cut