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


line stmt bran cond sub pod time code
1             # ABSTRACT: Multi-purpose emailer for HTML, auto-text, attachments, and templates
2              
3             use 5.014;
4 1     1   169304 use exact -noautoclean;
  1         6  
5 1     1   326  
  1         26531  
  1         5  
6             use Email::MessageID;
7 1     1   2113 use Email::MIME 1.940;
  1         520  
  1         26  
8 1     1   430 use Email::MIME::CreateHTML;
  1         18508  
  1         23  
9 1     1   372 use Email::Sender::Simple 'sendmail';
  1         77463  
  1         41  
10 1     1   342 use HTML::FormatText;
  1         132789  
  1         5  
11 1     1   588 use HTML::TreeBuilder;
  1         16714  
  1         26  
12 1     1   606 use IO::All 'io';
  1         5676  
  1         10  
13 1     1   444 use MIME::Words 'encode_mimewords';
  1         7841  
  1         6  
14 1     1   66  
  1         2  
  1         1239  
15             our $VERSION = '1.19'; # VERSION
16              
17             my $self = shift;
18              
19 14     14 1 27161 unless ( ref $self ) {
20             # $self is not an object, is incoming pair values = make $self object
21 14 100       35 $self = bless( {@_}, $self );
22             }
23 8         39 else {
24             # $self is an object = make a new $self object incorporating any new values
25             $self = bless( { %$self, @_ }, ref $self );
26             }
27 6         26  
28             # for a certain set of keys, ensure they are all lower-case
29             $self->{ lc $_ } = delete $self->{$_}
30             for ( grep { /^(?:to|from|subject|html|text)$/i and /[A-Z]/ } keys %$self );
31              
32 14 100       49 return $self;
  62         226  
33             }
34 14         69  
35             my $self = shift;
36              
37             # if @_ is a set of hashrefs, map them into new mail objects; otherwise, just merge in new values;
38 8     8 1 9445 # 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             my $mail = {%$_};
42              
43             # process any template functionality (look for values that are scalarrefs)
44 9         33 if ( ref $mail->{process} eq 'CODE' ) {
45             $mail->{$_} = $mail->{process}->( ${ $mail->{$_} }, $mail->{data} || {} )
46             for ( grep { ref $mail->{$_} eq 'SCALAR' } keys %$mail );
47 9 100       30 }
48 2         20  
49 1   50     4 # automatically create the text version from HTML if there is no text version and there is HTML
  6         22  
50             if ( $mail->{html} and not $mail->{text} ) {
51             my $width = $mail->{width} // 72;
52             $width ||= 1_000_000;
53 9 100 100     53  
54 6   100     18 $mail->{text} = HTML::FormatText
55 6   100     20 ->new( leftmargin => 0, rightmargin => $width )
56             ->format( HTML::TreeBuilder->new->parse( $mail->{html} ) );
57             }
58              
59 6         48 $mail->{'Content-Transfer-Encoding'} //= 'quoted-printable';
60             $mail->{'Content-Type'} ||= 'text/plain; charset=us-ascii';
61              
62 9   50     15205 my $charset = ( $mail->{'Content-Type'} =~ /\bcharset\s*=\s*([^;]+)/i ) ? $1 : 'ISO-8859-1';
63 9   50     43 my @keys = keys %$mail;
64             for my $name ( qw( to from subject ) ) {
65 9 50       68 my ($key) = grep { lc($_) eq $name } @keys;
66 9         33 $mail->{$key} = encode_mimewords( $mail->{$key}, Charset => $charset )
67 9         23 if ( $key and defined $mail->{$key} and $mail->{$key} =~ /[^[:ascii:]]/ );
68 27         38 }
  216         265  
69              
70 27 50 33     111 $mail->{'Message-Id'} //= Email::MessageID->new->in_brackets;
      33        
71              
72             # create a headers hashref (delete things from a data copy that known to not be headers)
73 9   33     59 my $headers = [
74             map {
75             $mail->{$_} = join( ',', @{ $mail->{$_} } ) if ( ref $mail->{$_} eq 'ARRAY' );
76             $mail->{$_} = join( ',', values %{ $mail->{$_} } ) if ( ref $mail->{$_} eq 'HASH' );
77             ucfirst($_) => $mail->{$_};
78 54 50       78 }
  0         0  
79 54 50       71 grep { not /^(?:html|text|embed|attachments|process|data|transport|width)$/i }
  0         0  
80 54         102 sort keys %$mail
81             ];
82 9         2263  
  81         153  
83             # build up an attachments arrayref of attachment MIME objects
84             my $attachments = ( not $mail->{attachments} or ref $mail->{attachments} ne 'ARRAY' ) ? [] : [
85             map {
86             Email::MIME->create(
87             attributes => {
88             disposition => 'attachment',
89             content_type => $_->{ctype} || 'application/octet-stream',
90             encoding => $_->{encoding} // 'base64',
91             filename => $_->{name} || $_->{filename} || $_->{source},
92             name => $_->{name} || $_->{filename} || $_->{source},
93             },
94             body => ( ( $_->{content} ) ? $_->{content} : io( $_->{source} )->binary->all ),
95             ),
96             } @{ $mail->{attachments} }
97 2 100 50     1854 ];
      50        
      33        
      33        
98              
99 9 100 66     38 # build a single MIME email object to send based on what data we have for the email
  1         3  
100             my $email_mime;
101             if ( $mail->{text} and not $mail->{html} and @$attachments == 0 ) {
102             $email_mime = Email::MIME->create(
103 9         1266 header_str => $headers,
104 9 100 66     66 body => $mail->{text},
    50 66        
      33        
105             );
106             }
107             elsif ( $mail->{text} and not $mail->{html} ) {
108 1         6 $email_mime = Email::MIME->create(
109             header_str => $headers,
110             attributes => { content_type => 'multipart/mixed' },
111             parts => [
112             Email::MIME->create(
113             header_str => [ map { $_ => $mail->{$_} } 'Content-Transfer-Encoding', 'Content-Type' ],
114             body => $mail->{text},
115             ),
116 0         0 @$attachments,
117             ],
118 0         0 );
119             }
120             else {
121             my $html_email = Email::MIME->create_html(
122             header => [],
123             body => $mail->{html},
124             text_body => $mail->{text},
125             embed => $mail->{embed},
126             );
127              
128             $html_email->walk_parts( sub {
129 8         68 my ($part) = @_;
130             return if $part->subparts;
131              
132 26     26   2621 if ( $part->content_type eq 'text/plain' ) {
133 26 100       58 $part->charset_set($charset);
134             $part->encoding_set( $mail->{'Content-Transfer-Encoding'} );
135 17 100       126 }
136 8         291 } );
137 8         1215  
138             $email_mime = Email::MIME->create(
139 8         79715 header_str => $headers,
140             attributes => { content_type => 'multipart/mixed' },
141 8         11886 parts => [ $html_email, @$attachments ],
142             );
143             }
144              
145             # send the email with Email::Sender::Simple
146             sendmail( $email_mime, { transport => $mail->{transport} } );
147              
148             $_;
149 9         32814 } ( ref $_[0] eq 'HASH' ) ? ( map { $self->new(%$_) } @_ ) : $self->new(@_);
150              
151 9         82 # return the mail objects as desired by the caller
152 8 100       41 return ( wantarray() ) ? (@mails) : \@mails;
  2         5  
153             }
154              
155 8 50       41 1;
156              
157              
158             =pod
159              
160             =encoding UTF-8
161              
162             =head1 NAME
163              
164             Email::Mailer - Multi-purpose emailer for HTML, auto-text, attachments, and templates
165              
166             =head1 VERSION
167              
168             version 1.19
169              
170             =for markdown [![test](https://github.com/gryphonshafer/Email-Mailer/workflows/test/badge.svg)](https://github.com/gryphonshafer/Email-Mailer/actions?query=workflow%3Atest)
171             [![codecov](https://codecov.io/gh/gryphonshafer/Email-Mailer/graph/badge.svg)](https://codecov.io/gh/gryphonshafer/Email-Mailer)
172              
173             =head1 SYNOPSIS
174              
175             use Email::Mailer;
176             my ( $to, $from, $subject, $text, $html );
177              
178             # send a simple text email
179             Email::Mailer->send(
180             to => $to,
181             from => $from,
182             subject => $subject,
183             text => $text,
184             );
185              
186             # send multi-part HTML/text email with the text auto-generated from the HTML
187             # and images and other resources embedded in the email
188             my $mail = Email::Mailer->new;
189             $mail->send(
190             to => $to,
191             from => $from,
192             subject => $subject,
193             html => $html,
194             );
195              
196             # send multi-part HTML/text email with the text auto-generated from the HTML
197             # but skip embedding images and other resources
198             Email::Mailer->new->send(
199             to => $to,
200             from => $from,
201             subject => $subject,
202             html => $html,
203             embed => 0,
204             );
205              
206             # send multi-part HTML/text email but supply the text explicitly
207             Email::Mailer->new(
208             to => $to,
209             from => $from,
210             subject => $subject,
211             html => $html,
212             text => $text,
213             )->send;
214              
215             # send multi-part HTML/text email with a couple of attached files
216             use IO::All 'io';
217             Email::Mailer->send(
218             to => $to,
219             from => $from,
220             subject => $subject,
221             html => $html,
222             text => $text,
223             attachments => [
224             {
225             ctype => 'application/pdf',
226             source => 'file.pdf',
227             },
228             {
229             ctype => 'application/pdf',
230             content => io('file.pdf')->binary->all,
231             encoding => 'base64',
232             name => 'file.pdf',
233             },
234             ],
235             );
236              
237             # build an email and iterate over a data set for sending
238             Email::Mailer->new(
239             from => $from,
240             subject => $subject,
241             html => $html,
242             )->send(
243             { to => 'person_0@example.com' },
244             { to => 'person_1@example.com' },
245             {
246             to => 'person_2@example.com',
247             subject => 'Override $subject with this',
248             },
249             );
250              
251             # setup a second mail object based on the first but changing the "from"
252             my $mail_0 = Email::Mailer->new(
253             from => $from,
254             subject => $subject,
255             html => $html,
256             );
257             my $mail_1 = $mail_0->new( from => 'different_address@example.com' );
258             $mail_0->send;
259             $mail_1->send;
260              
261             # use a templating system for the HTML and subject
262             use Template;
263             my $tt = Template->new;
264             my $tmail = Email::Mailer->new(
265             from => $from,
266             subject => \$subject,
267             html => \$html,
268             process => sub {
269             my ( $template, $data ) = @_;
270             my $content;
271             $tt->process( \$template, $data, \$content );
272             return $content;
273             },
274             );
275             $tmail->send($_) for (
276             { to => 'person_0@example.com', data => { name => 'Person 0' } },
277             { to => 'person_1@example.com', data => { name => 'Person 1' } },
278             );
279              
280             =head1 DESCRIPTION
281              
282             Following the charter and example of L<Email::Simple>, this module provides a
283             simple and flexible interface to sending various types of email including
284             plain text, HTML/text multi-part, attachment support, and template hooks.
285             The module depends on a series of great modules in the Email::* and HTML::*
286             namespaces.
287              
288             =head1 PRIMARY METHODS
289              
290             There are 2 primary methods.
291              
292             =head2 new
293              
294             This is an instantiator and a replicative instantiator. If passed nothing, it'll
295             return you a blank mail object. If you pass it anything, it'll use that data to
296             setup a more informed mail object for later sending.
297              
298             my $mail_blank = Email::Mailer->new;
299             my $mail_to = Email::Mailer->new( to => 'default_to@example.com');
300              
301             If you call C<new()> off an instantiated mail object, it'll make a copy of that
302             object, changing any internal data based on what you pass in to the C<new()>.
303              
304             # create a new object with both a default "To" and "From"
305             my $mail_to_from = $mail_to->new( from => 'default_from@example.com' );
306              
307             =head2 send
308              
309             This method will attempt to send mail. Any parameters you can pass to C<new()>
310             you can pass to C<send()>. Any incoming parameters will override any existing
311             parameters in an instantiated object.
312              
313             $mail_to_from->send(
314             subject => 'Example Subject Line',
315             text => 'Hello. This is example email content.',
316             );
317              
318             If C<send()> succeeds, it'll return an instantiated object based on the combined
319             parameters. If it fails, it'll throw an exception.
320              
321             use Try::Tiny;
322              
323             my $mail_with_all_the_parameters;
324             try {
325             $mail_with_all_the_parameters = $mail_to_from->send(
326             subject => 'Example Subject Line',
327             text => 'Hello. This is example email content.',
328             );
329             }
330             catch {
331             print "There was an error, but I'm going to ignore it and keep going.\n";
332             };
333              
334             You can also pass to C<send()> a list of hashrefs. If you do that, C<send()>
335             will assume you want each of the hashrefs to be like a set of data sent to an
336             independent call to C<send()>. The method will attempt to send multiple emails
337             based on your data, and it'll return an array or arrayref (based on context)
338             of the mail objects ultimately created.
339              
340             my @emails_sent = $mail_with_all_the_parameters->send(
341             { to => 'person_0@example.com' },
342             { to => 'person_1@example.com' },
343             );
344              
345             my $emails_sent = $mail_with_all_the_parameters->send(
346             { to => 'person_0@example.com' },
347             { to => 'person_1@example.com' },
348             );
349              
350             $mail_with_all_the_parameters->send($_) for (
351             { to => 'person_0@example.com' },
352             { to => 'person_1@example.com' },
353             );
354              
355             =head1 PARAMETERS
356              
357             There are a bunch of parameters you can pass to the primary methods. First off,
358             anything not explicitly mentioned in this section, the methods will assume is
359             a mail header.
360              
361             If any value of a key is a reference to scalar text, the value of that scalar
362             text will be assumed to be a template and processed through the subref defined
363             by the "process" parameter.
364              
365             =head2 html
366              
367             This parameter should contain HTML content (or a reference to scalar text that
368             is the template that'll be used to generate HTML content).
369              
370             =head2 text
371              
372             This parameter should contain plain text content (or a template reference). If
373             not provided then "text" will be automatically generated based on the "html"
374             content.
375              
376             By default, the text generated will be wrapped at 72 characters width. However,
377             you can override that by setting width explicitly:
378              
379             Email::Mailer->new->send(
380             to => $to,
381             from => $from,
382             subject => $subject,
383             html => $html,
384             width => 120,
385             );
386              
387             If you set a width to 0, this will be interpreted as meaning not to wrap text
388             lines.
389              
390             =head2 embed
391              
392             By default, if your HTML has links to things like images or CSS, those resources
393             will be pulled in and embedded into the email message. If you don't want that
394             behavior, turn it off by explicitly setting "embed" to a false value.
395              
396             Email::Mailer->new->send(
397             to => $to,
398             from => $from,
399             subject => $subject,
400             html => $html,
401             embed => 0,
402             );
403              
404             =head2 attachments
405              
406             This parameter if needed should be an arrayref of hashrefs that define the
407             attachments to add to an email. Each hashref should define a "ctype" for the
408             content type of the attachment and either a "source" or both a "name" and
409             "content" key. The "source" value should be a local relative path/file. The
410             "content" value should be binary data, and the "name" value should be the
411             filename of the attachment.
412              
413             use IO::All 'io';
414              
415             Email::Mailer->send(
416             to => $to,
417             from => $from,
418             subject => $subject,
419             html => $html,
420             text => $text,
421             attachments => [
422             {
423             ctype => 'application/pdf',
424             source => 'file.pdf',
425             },
426             {
427             ctype => 'application/pdf',
428             content => io('file.pdf')->binary->all,
429             encoding => 'base64',
430             name => 'file.pdf',
431             },
432             ],
433             );
434              
435             An optional parameter of "encoding" can be supplied in a hashref to
436             "attachments" to indicate what encoding the attachment should be encoded as.
437             If not specified, the default is "base64" encoding, which works in most cases.
438             Another popular choice is "quoted-printable".
439              
440             =head2 process
441              
442             This parameter expects a subref that will be called to process any templates.
443             You can hook in any template system you'd like. The subref will be passed the
444             template text and a hashref of the data for the message.
445              
446             use Template;
447              
448             my $tt = Template->new;
449             my $tmail = Email::Mailer->new(
450             from => $from,
451             subject => \$subject,
452             html => \$html,
453             process => sub {
454             my ( $template, $data ) = @_;
455             my $content;
456             $tt->process( \$template, $data, \$content );
457             return $content;
458             },
459             );
460              
461             =head2 data
462              
463             This parameter is the hashref of data that'll get passed to the "process"
464             subref.
465              
466             $tmail->send($_) for (
467             { to => 'person_0@example.com', data => { name => 'Person 0' } },
468             { to => 'person_1@example.com', data => { name => 'Person 1' } },
469             );
470              
471             =head2 transport
472              
473             By default, this module will try to pick an appropriate transport. (Well,
474             technically, L<Email::Sender::Simple> does that for us.) If you want to override
475             that and set your own transport, use the "transport" parameter.
476              
477             use Email::Sender::Transport::SMTP;
478              
479             Email::Mailer->send(
480             to => $to,
481             from => $from,
482             subject => $subject,
483             html => $html,
484             transport => Email::Sender::Transport::SMTP->new({
485             host => 'smtp.example.com',
486             port => 25,
487             }),
488             );
489              
490             =head1 AUTOMATIC HEADER-IFICATION
491              
492             There are some automatic header-ification features to be aware of. Unless you
493             specify a value, the C<Content-Type> and C<Content-Transfer-Encoding> are
494             set as "text/plain; charset=us-ascii" and "quoted-printable" respectively, as
495             if you set the following:
496              
497             Email::Mailer->send(
498             to => $to,
499             from => $from,
500             subject => $subject,
501             html => $html,
502              
503             'Content-Type' => 'text/plain; charset=us-ascii',
504             'Content-Transfer-Encoding' => 'quoted-printable',
505             );
506              
507             Also, normally your C<to>, C<from>, and C<subject> values are left untouched;
508             however, for any of these that contain non-ASCII characters, they will be
509             mimewords-encoded via L<MIME::Words> using the character set defined in
510             C<Content-Type>. If you don't like how that works, just encode them however
511             you'd like to ASCII.
512              
513             =head1 SEE ALSO
514              
515             L<Email::MIME>, L<Email::MIME::CreateHTML>, L<Email::Sender::Simple>,
516             L<Email::Sender::Transport>, L<HTML::FormatText>, L<HTML::TreeBuilder>.
517              
518             You can also look for additional information at:
519              
520             =over 4
521              
522             =item *
523              
524             L<GitHub|https://github.com/gryphonshafer/Email-Mailer>
525              
526             =item *
527              
528             L<MetaCPAN|https://metacpan.org/pod/Email::Mailer>
529              
530             =item *
531              
532             L<GitHub Actions|https://github.com/gryphonshafer/Email-Mailer/actions>
533              
534             =item *
535              
536             L<Codecov|https://codecov.io/gh/gryphonshafer/Email-Mailer>
537              
538             =item *
539              
540             L<CPANTS|http://cpants.cpanauthors.org/dist/Email-Mailer>
541              
542             =item *
543              
544             L<CPAN Testers|http://www.cpantesters.org/distro/D/Email-Mailer.html>
545              
546             =back
547              
548             =head1 AUTHOR
549              
550             Gryphon Shafer <gryphon@cpan.org>
551              
552             =head1 COPYRIGHT AND LICENSE
553              
554             This software is Copyright (c) 2017-2050 by Gryphon Shafer.
555              
556             This is free software, licensed under:
557              
558             The Artistic License 2.0 (GPL Compatible)
559              
560             =cut