| 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; | ||||||