File Coverage: lib/Email/Mailer.pm

# File Coverage

File: | lib/Email/Mailer.pm
Coverage: | 87.4%

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  |  | package Email::Mailer;
2 |  |  |  |  |  |  | # ABSTRACT: Multi-purpose emailer for HTML, auto-text, attachments, and templates
3 |
4 | 1 1 1 |  |  | 1 |  | 8 3 32 | use strict;
5 | 1 1 1 |  |  | 1 |  | 6 3 32 | use warnings;
6 | 1 1 1 |  |  | 1 |  | 471 47753 35 | use HTML::FormatText;
7 | 1 1 1 |  |  | 1 |  | 559 11390 35 | use HTML::TreeBuilder;
8 | 1 1 1 |  |  | 1 |  | 48 4 12 | use IO::All 'io';
9 | 1 1 1 |  |  | 1 |  | 882 79752 106 | use Email::MIME;
10 | 1 1 1 |  |  | 1 |  | 1998 157803 58 | use Email::MIME::CreateHTML;
11 | 1 1 1 |  |  | 1 |  | 532 148051 9 | use Email::Sender::Simple 'sendmail';
12 |
13 |  |  |  |  |  |  | # VERSION
14 |
15 |  |  |  |  |  |  | sub new {
16 | 14 |  |  | 14 | 1 | 56 | my $self = shift;
17 |
18 | 14 | 100 |  |  |  | 59 | unless ( ref $self ) {
19 |  |  |  |  |  |  | # $self is not an object, is incoming pair values = make $self object
20 | 8 |  |  |  |  | 60 | $self = bless( {@_}, $self );
21 |  |  |  |  |  |  | }
22 |  |  |  |  |  |  | else {
23 |  |  |  |  |  |  | # $self is an object = make a new $self object incorporating any new values
24 | 6 |  |  |  |  | 45 | $self = bless( { %$self, @_ }, ref $self );
25 |  |  |  |  |  |  | }
26 |
27 |  |  |  |  |  |  | # for a certain set of keys, ensure they are all lower-case
28 |  |  |  |  |  |  | $self->{ lc $_ } = delete $self->{$_}
29 | 14 54 | 100 |  |  |  | 78 500 | for ( grep { /^(?:to|from|subject|html|text)$/i and /[A-Z]/ } keys %$self );
30 |
31 | 14 |  |  |  |  | 112 | return $self;
32 |  |  |  |  |  |  | }
33 |
34 |  |  |  |  |  |  | sub send {
35 | 8 |  |  | 8 | 1 | 515 | my $self = shift;
36 |
37 |  |  |  |  |  |  | # if @_ is a set of hashrefs, map them into new mail objects; otherwise, just merge in new values;
38 |  |  |  |  |  |  | # then iterate through the objects inside the map
39 |  |  |  |  |  |  | my @mails = map {
40 |  |  |  |  |  |  | # make a clean copy of the data so we can return the mail object unchanged at the end
41 | 9 |  |  |  |  | 143 | my $mail = {%$_};
42 |
43 |  |  |  |  |  |  | # process any template functionality (look for values that are scalarrefs)
44 | 9 | 100 |  |  |  | 65 | if ( ref $mail->{process} eq 'CODE' ) {
45 | 2 |  |  |  |  | 11 | $mail->{$_} = $mail->{process}->( ${ $mail->{$_} }, $mail->{data} || {} )
46 | 1 6 |  | 50 |  |  | 6 24 | for ( grep { ref $mail->{$_} eq 'SCALAR' } keys %$mail );
47 |  |  |  |  |  |  | }
48 |
49 |  |  |  |  |  |  | # automatically create the text version from HTML if there is no text version and there is HTML
50 |  |  |  |  |  |  | $mail->{text} = HTML::FormatText
51 |  |  |  |  |  |  | ->new( leftmargin => 0, rightmargin => 1_000_000 )
52 |  |  |  |  |  |  | ->format( HTML::TreeBuilder->new->parse( $mail->{html} ) )
53 | 9 | 100 | 100 |  |  | 174 | if ( $mail->{html} and not $mail->{text} );
54 |
55 |  |  |  |  |  |  | # create a headers hashref (delete things from a data copy that known to not be headers)
56 |  |  |  |  |  |  | my $headers = [
57 | 27 |  |  |  |  | 136 | map { ucfirst($_) => $mail->{$_} }
58 | 9 48 |  |  |  |  | 14717 292 | grep { not /^(?:html|text|embed|attachments|process|data|transport)$/i }
59 |  |  |  |  |  |  | sort keys %$mail
60 |  |  |  |  |  |  | ];
61 |
62 |  |  |  |  |  |  | # build up an attachments arrayref of attachment MIME objects
63 |  |  |  |  |  |  | my $attachments = ( not $mail->{attachments} or ref $mail->{attachments} ne 'ARRAY' ) ? [] : [
64 |  |  |  |  |  |  | map {
65 |  |  |  |  |  |  | Email::MIME->create(
66 |  |  |  |  |  |  | attributes => {
67 |  |  |  |  |  |  | disposition => 'attachment',
68 |  |  |  |  |  |  | content_type => $_->{ctype} || 'application/octet-stream',
69 |  |  |  |  |  |  | encoding => 'quoted-printable',
70 |  |  |  |  |  |  | filename => $_->{name} || $_->{filename} || $_->{source},
71 |  |  |  |  |  |  | name => $_->{name} || $_->{filename} || $_->{source},
72 |  |  |  |  |  |  | },
73 | 2 | 100 | 33 50 33 |  |  | 1540 | body => ( ( $_->{content} ) ? $_->{content} : io( $_->{source} )->binary->all ),
74 |  |  |  |  |  |  | ),
75 | 9 1 | 100 | 67 |  |  | 69 5 | } @{ $mail->{attachments} }
76 |  |  |  |  |  |  | ];
77 |
78 |  |  |  |  |  |  | # build a single MIME email object to send based on what data we have for the email
79 | 9 |  |  |  |  | 1205 | my $email_mime;
80 | 9 | 100 50 | 20 |  |  | 132 | if ( $mail->{text} and not $mail->{html} and @$attachments == 0 ) {
81 |  |  |  |  |  |  | $email_mime = Email::MIME->create(
82 |  |  |  |  |  |  | header => $headers,
83 |  |  |  |  |  |  | body => $mail->{text},
84 | 1 |  |  |  |  | 10 | );
85 |  |  |  |  |  |  | }
86 |  |  |  |  |  |  | elsif ( $mail->{text} and not $mail->{html} ) {
87 |  |  |  |  |  |  | $email_mime = Email::MIME->create(
88 |  |  |  |  |  |  | header => $headers,
89 |  |  |  |  |  |  | attributes => { content_type => 'multipart/mixed' },
90 |  |  |  |  |  |  | parts => [
91 |  |  |  |  |  |  | Email::MIME->create(
92 |  |  |  |  |  |  | header => [],
93 |  |  |  |  |  |  | body => $mail->{text},
94 | 0 |  |  |  |  | 0 | ),
95 |  |  |  |  |  |  | @$attachments,
96 |  |  |  |  |  |  | ],
97 |  |  |  |  |  |  | );
98 |  |  |  |  |  |  | }
99 |  |  |  |  |  |  | else {
100 |  |  |  |  |  |  | $email_mime = Email::MIME->create(
101 |  |  |  |  |  |  | header => $headers,
102 |  |  |  |  |  |  | attributes => { content_type => 'multipart/mixed' },
103 |  |  |  |  |  |  | parts => [
104 |  |  |  |  |  |  | Email::MIME->create_html(
105 |  |  |  |  |  |  | header => [],
106 |  |  |  |  |  |  | body => $mail->{html},
107 |  |  |  |  |  |  | text_body => $mail->{text},
108 |  |  |  |  |  |  | embed => $mail->{embed},
109 | 8 |  |  |  |  | 115 | ),
110 |  |  |  |  |  |  | @$attachments,
111 |  |  |  |  |  |  | ],
112 |  |  |  |  |  |  | );
113 |  |  |  |  |  |  | }
114 |
115 |  |  |  |  |  |  | # send the email with Email::Sender::Simple
116 | 9 |  |  |  |  | 107361 | sendmail( $email_mime, $mail->{transport} );
117 |
118 | 9 |  |  |  |  | 108 | $_;
119 | 8 2 | 100 |  |  |  | 54 10 | } ( ref $_[0] eq 'HASH' ) ? ( map { $self->new(%$_) } @_ ) : $self->new(@_);
120 |
121 |  |  |  |  |  |  | # return the mail objects as desired by the caller
122 | 8 | 50 |  |  |  | 103 | return ( wantarray() ) ? (@mails) : \@mails;
123 |  |  |  |  |  |  | }
124 |
125 |  |  |  |  |  |  | 1;