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 | 8 3 32 | use strict; | ||||
5 | 1 1 1 | 6 3 32 | use warnings; | ||||
6 | 1 1 1 | 471 47753 35 | use HTML::FormatText; | ||||
7 | 1 1 1 | 559 11390 35 | use HTML::TreeBuilder; | ||||
8 | 1 1 1 | 48 4 12 | use IO::All 'io'; | ||||
9 | 1 1 1 | 882 79752 106 | use Email::MIME; | ||||
10 | 1 1 1 | 1998 157803 58 | use Email::MIME::CreateHTML; | ||||
11 | 1 1 1 | 532 148051 9 | use Email::Sender::Simple 'sendmail'; | ||||
12 | |||||||
13 | # VERSION | ||||||
14 | |||||||
15 | sub new { | ||||||
16 | 14 | 1 | 56 | my $self = shift; | |||
17 | |||||||
18 | 14 | 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 | 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 | 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 | 65 | if ( ref $mail->{process} eq 'CODE' ) { | ||||
45 | 2 | 11 | $mail->{$_} = $mail->{process}->( ${ $mail->{$_} }, $mail->{data} || {} ) | ||||
46 | 1 6 | 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 | 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 | 1540 | body => ( ( $_->{content} ) ? $_->{content} : io( $_->{source} )->binary->all ), | ||||
74 | ), | ||||||
75 | 9 1 | 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 | 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 | 54 10 | } ( ref $_[0] eq 'HASH' ) ? ( map { $self->new(%$_) } @_ ) : $self->new(@_); | ||||
120 | |||||||
121 | # return the mail objects as desired by the caller | ||||||
122 | 8 | 103 | return ( wantarray() ) ? (@mails) : \@mails; | ||||
123 | } | ||||||
124 | |||||||
125 | 1; |