File Coverage

blib/lib/Email/Sender/Transport/Mailgun.pm

Criterion	Covered	Total	%
statement	65	66	98.4
branch	13	14	92.8
condition	6	6	100.0
subroutine	16	17	94.1
pod	0	3	0.0
total	100	106	94.3

package Email::Sender::Transport::Mailgun;
our $VERSION = "0.05";

use Moo;
with 'Email::Sender::Transport';

use HTTP::Tiny                      qw( );
use HTTP::Tiny::Multipart           qw( );
use JSON::MaybeXS                   qw( );
use MooX::Types::MooseLike::Base    qw( ArrayRef Enum Str);

{
  package
    Email::Sender::Success::MailgunSuccess;
  use Moo;
  extends 'Email::Sender::Success';
  has id => (
    is  => 'ro',
    required => 1,
  );
  no Moo;
}

has [qw( api_key domain )] => (
    is => 'ro',
    required => 1,
    isa => Str,
);

has [qw( tag )] => (
    is => 'ro',
    predicate => 1,
    isa => ArrayRef[Str],
    coerce => sub { ref $_[0] ? $_[0] : [ split(/,\s*/, $_[0]) ] },
);

has deliverytime => (
    is => 'ro',
    predicate => 1,
    isa => Str,
    coerce => sub {
        ref $_[0] eq 'DateTime'
            ? $_[0]->strftime('%a, %d %b %Y %H:%M:%S %z') : $_[0]
    },
);

has [qw( dkim testmode tracking tracking_opens )] => (
    is => 'ro',
    predicate => 1,
    isa => Enum[qw( yes no )],
);

has tracking_clicks => (
    is => 'ro',
    predicate => 1,
    isa => Enum[qw( yes no htmlonly )],
);

has region => (
    is => 'ro',
    predicate => 1,
    isa => Enum[qw( us eu )],
);

has retry_count => (
    is => 'lazy',
    builder => sub { 3 }, # set to 0 to disable retries
);

has retry_delay_seconds => (
    is => 'lazy',
    builder => sub { 1 },
);

has base_uri => (
    is => 'lazy',
    builder => sub { 'https://api.mailgun.net/v3' },
);

has uri => (
    is => 'lazy',
);

has ua => (
    is => 'lazy',
    builder => sub { HTTP::Tiny->new(verify_SSL => 1) },
);

has json => (
    is => 'lazy',
    builder => sub { JSON::MaybeXS->new },
);

# https://documentation.mailgun.com/en/latest/api-sending.html#sending
sub send_email {
    my ($self, $email, $env) = @_;

    my $content = {
        to => ref $env->{to} ? join(',', @{ $env->{to} }) : $env->{to},
        message => {
            filename => 'message.mime',
            content => $email->as_string,
        },
    };

    my @options = qw(
        deliverytime dkim tag testmode tracking tracking_clicks tracking_opens
    );

    for my $option (@options) {
        my $has_option = "has_$option";
        if ($self->$has_option) {
            my $key = "o:$option";
            $key =~ tr/_/-/;
            $content->{$key} = $self->$option;
        }
    }

    my $uri = $self->uri . '/messages.mime';

    # If we get a 5xx error, retry a few times.
    # Been seeing "Socket closed by remote server: Broken pipe" errors (EPIPE).
    my $retries = 0;

    my $response;
    while (1) {
        $response = $self->ua->post_multipart($uri, $content);
        last if $response->{status} !~ /^5/;
        last if $retries++ >= $self->retry_count;
        sleep $self->retry_delay_seconds;
    }

    $self->failure($response, $env->{to})
        unless $response->{success};

    return $self->success($response);
}

sub success {
    my ($self, $response) = @_;

    my $content = $self->json->decode($response->{content});
    return Email::Sender::Success::MailgunSuccess->new(id => $content->{id});
}

sub failure {
    my ($self, $response, $recipients) = @_;

    # Most errors have { message => $message } in the content, some, such as
    # an auth error, have just a plain string.
    my $content = eval { $self->json->decode($response->{content}) };
    my $message = $content && $content->{message}
                ? $content->{message} : $response->{content};

    Email::Sender::Failure->throw({
        message    => $message,
        recipients => $recipients,
    });
}

sub _build_uri {
    my $self = shift;

    my ($proto, $rest) = split('://', $self->base_uri);
    my $domain = $self->domain;

    # Percent-escape anything other than alphanumeric and - _ . ~
    # https://github.com/sdt/Email-Sender-Transport-Mailgun/issues/4
    my $api_key = $self->api_key;
    $api_key =~ s/[^-_.~0-9a-zA-Z]/sprintf('%%%02x',ord($&))/eg;

    # adapt endpoint based on region setting.
    $rest =~ s/(\.mailgun)/sprintf('.%s%s', $self->region, $1)/e
        if defined $self->region && $self->region ne 'us';

    return "$proto://api:$api_key\@$rest/$domain";
}

no Moo;
1;
__END__

=encoding utf-8

=for stopwords deliverytime dkim hardcode mailouts prepend templated testmode

=head1 NAME

Email::Sender::Transport::Mailgun - Mailgun transport for Email::Sender

=head1 SYNOPSIS

    use Email::Sender::Simple qw( sendmail );
    use Email::Sender::Transport::Mailgun qw( );

    my $transport = Email::Sender::Transport::Mailgun->new(
        api_key => '...',
        domain  => '...',
    );

    my $message = ...;

    sendmail($message, { transport => $transport });

=head1 DESCRIPTION

This transport delivers mail via Mailgun's messages.mime API.

=head2 Why use this module?

The SMTP transport can also be used to send messages through Mailgun. In this
case, Mailgun options must be specified with Mailgun-specific MIME headers.

This module exposes those options as attributes, which can be set in code, or
via C<EMAIL_SENDER_TRANSPORT_> environment variables.

=head2 Why not use this module?

This module uses Mailgun's messages.mime API, not the full-blown messages API.

If you want to use advanced Mailgun features such as templated batch mailouts
or mailing lists, you're better off using something like L<WebService::Mailgun>
or L<WWW::Mailgun>.

=head1 REQUIRED ATTRIBUTES

The attributes all correspond directly to Mailgun parameters.

=head2 api_key

Mailgun API key. See L<https://documentation.mailgun.com/en/latest/api-intro.html#authentication-1>

=head2 domain

Mailgun domain. See L<https://documentation.mailgun.com/en/latest/api-intro.html#base-url-1>

=head1 OPTIONAL ATTRIBUTES

These (except region) correspond to the C<o:> options in the C<messages.mime>
section of L<https://documentation.mailgun.com/en/latest/api-sending.html#sending>

=head2 deliverytime

Desired time of delivery. String or DateTime object.

=head2 dkim

Enables/disables DKIM signatures. C<'yes'> or C<'no'>.

=head2 region

Defines used Mailgun region. C<'us'> (default) or C<'eu'>.

See L<https://documentation.mailgun.com/en/latest/api-intro.html#mailgun-regions-1>

=head2 retry_count

=head2 retry_delay_seconds

If the Mailgun API request fails with a 5xx response, the request will be retried C<retry_count> times, with a delay of C<retry_delay_seconds> between each attempt.

Defaults to three retries with a one second delay.

=head2 tag

Tag string. Comma-separated string list or arrayref of strings.

=head2 testmode

Enables sending in test mode. C<'yes'> or C<'no'>.

=head2 tracking

Toggles tracking. C<'yes'> or C<'no'>.

=head2 tracking_clicks

Toggles clicks tracking. C<'yes'>, C<'no'> or C<'html_only'>.

=head2 tracking_opens

Toggles open tracking. C<'yes'> or C<'no'>.

=head1 MIME HEADERS

The C<o:> options above can also be specified using the C<X-Mailgun-> headers
listed here L<https://documentation.mailgun.com/en/latest/user_manual.html#sending-via-smtp>

If a single-valued option is specified in both the options and the headers,
experimentation shows the header takes precedence. This doesn't seem to be
documented, so don't rely on this behaviour.

Multi-valued options use both the options and the headers.

=head1 ENVIRONMENT

The great strength of Email::Sender is that you don't need to hardcode your
transport, nor any of the options relating to that transport. They can all be
specified via environment variables.

To select the Mailgun transport, use C<EMAIL_SENDER_TRANSPORT=Mailgun>.

To specify any of the attributes above, prepend the attribute name with
C<EMAIL_SENDER_TRANSPORT_>.

=over

=item EMAIL_SENDER_TRANSPORT_api_key

=item EMAIL_SENDER_TRANSPORT_domain

=item EMAIL_SENDER_TRANSPORT_deliverytime

=item EMAIL_SENDER_TRANSPORT_dkim

=item EMAIL_SENDER_TRANSPORT_region

=item EMAIL_SENDER_TRANSPORT_retry_count

=item EMAIL_SENDER_TRANSPORT_retry_delay_seconds

=item EMAIL_SENDER_TRANSPORT_tag

=item EMAIL_SENDER_TRANSPORT_testmode

=item EMAIL_SENDER_TRANSPORT_tracking

=item EMAIL_SENDER_TRANSPORT_tracking_clicks

=item EMAIL_SENDER_TRANSPORT_tracking_opens

=back

=head1 LICENSE

Copyright (C) Stephen Thirlwall.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Stephen Thirlwall E<lt>[e-mail]<gt>

=cut