File Coverage

blib/lib/Dancer2/Plugin/Email.pm

Criterion	Covered	Total	%
statement	54	74	72.9
branch	6	24	25.0
condition	7	24	29.1
subroutine	10	10	100.0
pod	1	1	100.0
total	78	133	58.6

package Dancer2::Plugin::Email;

our $VERSION = '0.0200'; # VERSION

use strict;
use warnings;

use Dancer2::Core::Types qw/HashRef/;
use Dancer2::Plugin;
use Email::Sender::Simple 'sendmail';
use Email::Date::Format 'email_date';
use File::Type;
use MIME::Entity;
use Module::Load 'load';

has headers => (
    is          => 'ro',
    isa         => HashRef,
    from_config => sub { +{} },
);

has transport => (
    is          => 'ro',
    isa         => HashRef,
    from_config => sub { +{} },
);

plugin_keywords 'email';

sub email {
    my ($plugin, $params) = @_;
    $params ||= {};
    my $multipart = delete $params->{multipart};
    my $extra_headers = delete($params->{headers}) || {};
    my %headers = ( %{ $plugin->headers }, %$params, %$extra_headers );
    my $attach = $headers{attach};
    my $sender = delete $headers{sender};
    if (my $type = $headers{type}) {
        $headers{Type} = $type eq 'html' ? 'text/html' : 'text/plain';
    }
    $headers{Type}   ||= 'text/plain';
    $headers{Format} ||= 'flowed' if $headers{Type} eq 'text/plain';
    $headers{Date}   ||= email_date();
    delete $headers{$_} for qw(body message attach type);

    my $email = MIME::Entity->build(
        Charset  => 'utf-8',
        Encoding => 'quoted-printable',
        %headers, # %headers may overwrite type, charset, and encoding
        Data => $params->{body} || $params->{message},
    );
    if ($attach) {
        if ($multipart) {
            # by default, when you add an attachment,
            # C will be called by MIME::Entity, but
            # defaults to 'mixed'. Thunderbird doesn't like this for
            # embedded images, so we have a chance to set it to
            # 'related' or anything that the user wants
            $email->make_multipart($multipart);
        }
        my @attachments = ref($attach) eq 'ARRAY' ? @$attach : $attach;
        for my $attachment (@attachments) {
            my %mime;
            if (ref($attachment) eq 'HASH') {
                %mime = %$attachment;
                unless ($mime{Path} || $mime{Data}) {
                    $plugin->app->log('warning', "No Path or Data provided for this attachment!");
                    next;
                };
                if ( $mime{Path} ) {
                    $mime{Encoding} ||= 'base64';
                    $mime{Type} ||= File::Type->mime_type( $mime{Path} ),;
                }
            } else {
                %mime = (
                    Path     => $attachment,
                    Type     => File::Type->mime_type($attachment),
                    Encoding => 'base64',
                );
            }
            $email->attach(%mime);
        }
    }

    my $transport;
    if (my ($transport_name) = keys %{ $plugin->transport }) {
        my $transport_params = $plugin->transport->{$transport_name} || {};
        my $transport_class = "Email::Sender::Transport::$transport_name";
        my $transport_redirect = $transport_params->{redirect_address};
        load $transport_class;
        $transport = $transport_class->new($transport_params);

        if ($transport_redirect) {
            $transport_class = 'Email::Sender::Transport::Redirect';
            load $transport_class;
            $plugin->app->log('debug', "Redirecting email to $transport_redirect.");
            $transport = $transport_class->new(
                transport        => $transport,
                redirect_address => $transport_redirect
            );
        }
    }
    my %sendmail_arg = ( transport => $transport );
    $sendmail_arg{from} = $sender if defined $sender;
    return sendmail $email, \%sendmail_arg;
};

# ABSTRACT: Simple email sending for Dancer2 applications


1;

__END__