File Coverage

blib/lib/Email/Mailer.pm

Criterion	Covered	Total	%
statement	79	83	95.1
branch	26	32	81.2
condition	24	44	54.5
subroutine	13	13	100.0
pod	2	2	100.0
total	144	174	82.7

package Email::Mailer;
# ABSTRACT: Multi-purpose emailer for HTML, auto-text, attachments, and templates

use 5.014;
use exact -noautoclean;

use Email::MessageID;
use Email::MIME 1.940;
use Email::MIME::CreateHTML;
use Email::Sender::Simple 'sendmail';
use HTML::FormatText;
use HTML::TreeBuilder;
use IO::All 'io';
use MIME::Words 'encode_mimewords';

our $VERSION = '1.18'; # VERSION

sub new {
    my $self = shift;

    unless ( ref $self ) {
        # $self is not an object, is incoming pair values = make $self object
        $self = bless( {@_}, $self );
    }
    else {
        # $self is an object = make a new $self object incorporating any new values
        $self = bless( { %$self, @_ }, ref $self );
    }

    # for a certain set of keys, ensure they are all lower-case
    $self->{ lc $_ } = delete $self->{$_}
        for ( grep { /^(?:to|from|subject|html|text)$/i and /[A-Z]/ } keys %$self );

    return $self;
}

sub send {
    my $self = shift;

    # if @_ is a set of hashrefs, map them into new mail objects; otherwise, just merge in new values;
    # then iterate through the objects inside the map
    my @mails = map {
        # make a clean copy of the data so we can return the mail object unchanged at the end
        my $mail = {%$_};

        # process any template functionality (look for values that are scalarrefs)
        if ( ref $mail->{process} eq 'CODE' ) {
            $mail->{$_} = $mail->{process}->( ${ $mail->{$_} }, $mail->{data} || {} )
                for ( grep { ref $mail->{$_} eq 'SCALAR' } keys %$mail );
        }

        # automatically create the text version from HTML if there is no text version and there is HTML
        if ( $mail->{html} and not $mail->{text} ) {
            my $width = $mail->{width} // 72;
            $width ||= 1_000_000;

            $mail->{text} = HTML::FormatText
                ->new( leftmargin => 0, rightmargin => $width )
                ->format( HTML::TreeBuilder->new->parse( $mail->{html} ) );
        }

        $mail->{'Content-Transfer-Encoding'} //= 'quoted-printable';
        $mail->{'Content-Type'}              ||= 'text/plain; charset=us-ascii';

        my $charset = ( $mail->{'Content-Type'} =~ /\bcharset\s*=\s*([^;]+)/i ) ? $1 : 'ISO-8859-1';
        my @keys    = keys %$mail;
        for my $name ( qw( to from subject ) ) {
            my ($key) = grep { lc($_) eq $name } @keys;
            $mail->{$key} = encode_mimewords( $mail->{$key}, Charset => $charset )
                if ( $key and defined $mail->{$key} and $mail->{$key} =~ /[^[:ascii:]]/ );
        }

        $mail->{'Message-Id'} //= Email::MessageID->new->in_brackets;

        # create a headers hashref (delete things from a data copy that known to not be headers)
        my $headers = [
            map {
                $mail->{$_} = join( ',', @{ $mail->{$_} }        ) if ( ref $mail->{$_} eq 'ARRAY' );
                $mail->{$_} = join( ',', values %{ $mail->{$_} } ) if ( ref $mail->{$_} eq 'HASH'  );
                ucfirst($_) => $mail->{$_};
            }
            grep { not /^(?:html|text|embed|attachments|process|data|transport|width)$/i }
            sort keys %$mail
        ];

        # build up an attachments arrayref of attachment MIME objects
        my $attachments = ( not $mail->{attachments} or ref $mail->{attachments} ne 'ARRAY' ) ? [] : [
            map {
                Email::MIME->create(
                    attributes => {
                        disposition  => 'attachment',
                        content_type => $_->{ctype} || 'application/octet-stream',
                        encoding     => $_->{encoding} // 'base64',
                        filename     => $_->{name} || $_->{filename} || $_->{source},
                        name         => $_->{name} || $_->{filename} || $_->{source},
                    },
                    body => ( ( $_->{content} ) ? $_->{content} : io( $_->{source} )->binary->all ),
                ),
            } @{ $mail->{attachments} }
        ];

        # build a single MIME email object to send based on what data we have for the email
        my $email_mime;
        if ( $mail->{text} and not $mail->{html} and @$attachments == 0 ) {
            $email_mime = Email::MIME->create(
                header_str => $headers,
                body       => $mail->{text},
            );
        }
        elsif ( $mail->{text} and not $mail->{html} ) {
            $email_mime = Email::MIME->create(
                header_str => $headers,
                attributes => { content_type => 'multipart/mixed' },
                parts      => [
                    Email::MIME->create(
                        header_str => [ map { $_ => $mail->{$_} } 'Content-Transfer-Encoding', 'Content-Type' ],
                        body   => $mail->{text},
                    ),
                    @$attachments,
                ],
            );
        }
        else {
            my $html_email = Email::MIME->create_html(
                header    => [],
                body      => $mail->{html},
                text_body => $mail->{text},
                embed     => $mail->{embed},
            );

            $html_email->walk_parts( sub {
                my ($part) = @_;
                return if $part->subparts;

                if ( $part->content_type eq 'text/plain' ) {
                    $part->charset_set($charset);
                    $part->encoding_set( $mail->{'Content-Transfer-Encoding'} );
                }
            } );

            $email_mime = Email::MIME->create(
                header_str => $headers,
                attributes => { content_type => 'multipart/mixed' },
                parts      => [ $html_email, @$attachments ],
            );
        }

        # send the email with Email::Sender::Simple
        sendmail( $email_mime, { transport => $mail->{transport} } );

        $_;
    } ( ref $_[0] eq 'HASH' ) ? ( map { $self->new(%$_) } @_ ) : $self->new(@_);

    # return the mail objects as desired by the caller
    return ( wantarray() ) ? (@mails) : \@mails;
}

1;

__END__