File Coverage

blib/lib/Log/Dispatch/Email/Mailer.pm
Criterion Covered Total %
statement 33 33 100.0
branch 7 8 87.5
condition 7 12 58.3
subroutine 7 7 100.0
pod 2 3 66.6
total 56 63 88.8


line stmt bran cond sub pod time code
1             package Log::Dispatch::Email::Mailer;
2             # ABSTRACT: Log::Dispatch::Email subclass that sends mail using Email::Mailer
3              
4 1     1   204473 use 5.014;
  1         9  
5 1     1   422 use exact 'Log::Dispatch::Email';
  1         30267  
  1         4  
6 1     1   223064 use Email::Mailer;
  1         283528  
  1         486  
7              
8             our $VERSION = '1.13'; # VERSION
9              
10             sub _params {
11 14     14   59 my %params = @_;
12 14         63 delete $params{$_} for ( qw( buffer buffered level_names level_numbers max_level min_level name ) );
13 14         51 return %params;
14             }
15              
16             sub new {
17 6     6 0 18234 my $self = shift->SUPER::new(@_);
18              
19 6         933 my %params = _params( @_, %$self );
20 6         22 delete $params{$_} for ( qw( message mailer level ) );
21 6   33     40 $self->{mailer} //= Email::Mailer->new(%params);
22              
23 6         134 for ( qw( html text ) ) {
24 12 100 66     39 $self->{$_} = $params{$_} if ( not exists $self->{$_} and exists $params{$_} );
25             }
26              
27 6         21 return $self;
28             }
29              
30             sub send_email {
31 8     8 1 184 my $self = shift;
32              
33 8         36 my %params = _params( @_, %$self );
34 8 100       34 $params{data}{messages} = ( ref $params{message} ) ? $params{message} : [ $params{message} ];
35 8         10 $params{data}{message} = join( "\n", @{ $params{data}{messages} } );
  8         23  
36 8 50 66     39 $params{text} = $params{data}{message} unless ( $self->{html} or $self->{text} );
37 8         20 delete $params{$_} for ( qw( message mailer level ) );
38              
39 8         30 $self->{mailer}->send(%params);
40 8         31355 return;
41             }
42              
43             sub flush {
44 6     6 1 673 my $self = shift;
45              
46 6 100 66     15 if ( $self->{buffered} and @{ $self->{buffer} } ) {
  5         17  
47 5         12 $self->send_email( message => $self->{buffer} );
48 5         12 $self->{buffer} = [];
49             }
50              
51 6         35 return;
52             }
53              
54             1;
55              
56             __END__
57              
58             =pod
59              
60             =encoding UTF-8
61              
62             =head1 NAME
63              
64             Log::Dispatch::Email::Mailer - Log::Dispatch::Email subclass that sends mail using Email::Mailer
65              
66             =head1 VERSION
67              
68             version 1.13
69              
70             =for markdown [![test](https://github.com/gryphonshafer/Log-Dispatch-Email-Mailer/workflows/test/badge.svg)](https://github.com/gryphonshafer/Log-Dispatch-Email-Mailer/actions?query=workflow%3Atest)
71             [![codecov](https://codecov.io/gh/gryphonshafer/Log-Dispatch-Email-Mailer/graph/badge.svg)](https://codecov.io/gh/gryphonshafer/Log-Dispatch-Email-Mailer)
72              
73             =head1 SYNOPSIS
74              
75             use Log::Dispatch;
76              
77             # simple text email alert via Log::Dispatch
78             my $log = Log::Dispatch->new(
79             outputs => [
80             [
81             'Email::Mailer',
82             min_level => 'alert',
83             to => [ qw( foo@example.com bar@example.org ) ],
84             subject => 'Alert Log Message',
85             ],
86             ],
87             );
88             $log->alert('This is to alert you something happened.');
89              
90             # simple text email alert via direct instantiation
91             my $email = Log::Dispatch::Email::Mailer->new(
92             min_level => 'alert',
93             to => [ qw( foo@example.com bar@example.org ) ],
94             subject => 'Alert Log Message',
95             );
96             $email->log(
97             message => 'This is to alert you something happened.',
98             level => 'alert',
99             );
100              
101             # simple text email using an Email::Mailer object with explicit transport
102             $log = Log::Dispatch->new(
103             outputs => [
104             [
105             'Email::Mailer',
106             min_level => 'alert',
107             to => [ qw( foo@example.com bar@example.org ) ],
108             subject => 'Alert Log Message',
109             mailer => Email::Mailer->new(
110             transport => Email::Sender::Transport::SMTP->new({
111             host => 'smtp.example.com',
112             port => 25,
113             }),
114             ),
115             ],
116             ],
117             );
118             $log->alert('This is to alert you something happened.');
119              
120             # HTML email alert with attached log file using Template Toolkit
121             use Template;
122             my $tt = Template->new;
123             $log = Log::Dispatch->new(
124             outputs => [
125             [
126             'Email::Mailer',
127             min_level => 'alert',
128             to => [ qw( foo@example.com bar@example.org ) ],
129             subject => 'Alert Log Message',
130             html => \q{
131             <pre>[% message %]</pre>
132             <p>[% messages.join("<br>") %]</p>
133             },
134             attachments => [
135             {
136             ctype => 'text/plain',
137             content => 'This is plain text attachment content.',
138             name => 'log_file.txt',
139             },
140             ],
141             process => sub {
142             my ( $template, $data ) = @_;
143             my $content;
144             $tt->process( \$template, $data, \$content );
145             return $content;
146             },
147             ],
148             ],
149             );
150             $log->alert('This is to alert you something happened.');
151              
152             =head1 DESCRIPTION
153              
154             This is a subclass of L<Log::Dispatch::Email> that implements the C<send_email()>
155             method using the L<Email::Mailer> module. Much like the L<Email::Mailer> module,
156             you can send email in a great variety of ways including text-only, HTML with
157             text auto-generated, including attachments, and even using your favorite
158             templating system.
159              
160             =head2 Simple Text Email
161              
162             The simplest way to use this module is to setup an "outputs" record with
163             L<Log::Dispatch> much like you would any other email subclass.
164              
165             my $log = Log::Dispatch->new(
166             outputs => [
167             [
168             'Email::Mailer',
169             min_level => 'alert',
170             to => [ qw( foo@example.com bar@example.org ) ],
171             subject => 'Alert Log Message',
172             ],
173             ],
174             );
175             $log->alert('This is to alert you something happened.');
176              
177             By default, log messages are buffered and sent either when C<$log> is destroyed
178             or when you call C<< $log->flush >>.
179              
180             $log->alert('This message will appear in an email.');
181             $log->alert('This message will appear in the same email, but not yet...');
182             $log->flush; # now both alerts will get sent in one email
183              
184             Note that unlike many other L<Log::Dispatch::Email> subclasses, multiple
185             buffered messages won't be concatenated together without spaces. Instead, the
186             messages will appear in a text-only email as independent lines.
187              
188             As an alternative to buffering, you can explicitly set buffering off to have
189             each log line send a single email.
190              
191             my $log = Log::Dispatch->new(
192             outputs => [
193             [
194             'Email::Mailer',
195             min_level => 'alert',
196             to => [ qw( foo@example.com bar@example.org ) ],
197             subject => 'Alert Log Message',
198             buffer => 0,
199             ],
200             ],
201             );
202             $log->alert('This will be in one email.');
203             $log->alert('This will be in a second email.');
204              
205             =head2 Simple Text Email with Explicit Transport
206              
207             By default, this module will create its own L<Email::Mailer> object through
208             which to send email. You can provide a "mailer" value of an explicit
209             L<Email::Mailer> object you create and control, thus allowing you to set things
210             like an explicit transport mechanism.
211              
212             my $log = Log::Dispatch->new(
213             outputs => [
214             [
215             'Email::Mailer',
216             min_level => 'alert',
217             to => [ qw( foo@example.com bar@example.org ) ],
218             subject => 'Alert Log Message',
219             mailer => Email::Mailer->new(
220             transport => Email::Sender::Transport::SMTP->new({
221             host => 'smtp.example.com',
222             port => 25,
223             }),
224             ),
225             ],
226             ],
227             );
228             $log->alert('This is to alert you something happened.');
229              
230             =head2 HTML Email with Attached File Using Template Toolkit
231              
232             If you want to have some real fun with sending email log messages (and let's be
233             real here, who doesn't), try using this module to send templated HTML email
234             with attachments. Any key/value you can pass to L<Email::Mailer>, you can pass
235             as part of the "outputs" element.
236              
237             The following example uses an HTML template (which per L<Email::Mailer> needs
238             to be a scalar reference) and a very simple Template Toolkit process subref.
239              
240             use Template;
241             my $tt = Template->new;
242             my $log = Log::Dispatch->new(
243             outputs => [
244             [
245             'Email::Mailer',
246             min_level => 'alert',
247             to => [ qw( foo@example.com bar@example.org ) ],
248             subject => 'Alert Log Message',
249             html => \q{
250             <pre>[% message %]</pre>
251             <p>[% messages.join("<br>") %]</p>
252             },
253             attachments => [
254             {
255             ctype => 'text/plain',
256             content => 'This is plain text attachment content.',
257             name => 'log_file.txt',
258             },
259             ],
260             process => sub {
261             my ( $template, $data ) = @_;
262             my $content;
263             $tt->process( \$template, $data, \$content );
264             return $content;
265             },
266             ],
267             ],
268             );
269             $log->alert('This is to alert you something happened.');
270              
271             What's happening behind the scenes is that the "data" value that you'd normally
272             pass to L<Email::Mailer> that would work its way down into the "process" subref
273             is in this case being generated for you. It gets populated with two sub-keys:
274             message and messages. The first is a "\n"-separated string of log messages.
275             The second is an arrayref of those strings.
276              
277             =head1 SEE ALSO
278              
279             L<Email::Mailer>, L<Log::Dispatch::Email>, L<Log::Dispatch>.
280              
281             You can also look for additional information at:
282              
283             =over 4
284              
285             =item *
286              
287             L<GitHub|https://github.com/gryphonshafer/Log-Dispatch-Email-Mailer>
288              
289             =item *
290              
291             L<MetaCPAN|https://metacpan.org/pod/Log::Dispatch::Email::Mailer>
292              
293             =item *
294              
295             L<GitHub Actions|https://github.com/gryphonshafer/Log-Dispatch-Email-Mailer/actions>
296              
297             =item *
298              
299             L<Codecov|https://codecov.io/gh/gryphonshafer/Log-Dispatch-Email-Mailer>
300              
301             =item *
302              
303             L<CPANTS|http://cpants.cpanauthors.org/dist/Log-Dispatch-Email-Mailer>
304              
305             =item *
306              
307             L<CPAN Testers|http://www.cpantesters.org/distro/D/Log-Dispatch-Email-Mailer.html>
308              
309             =back
310              
311             =head1 AUTHOR
312              
313             Gryphon Shafer <gryphon@cpan.org>
314              
315             =head1 COPYRIGHT AND LICENSE
316              
317             This software is Copyright (c) 2017-2050 by Gryphon Shafer.
318              
319             This is free software, licensed under:
320              
321             The Artistic License 2.0 (GPL Compatible)
322              
323             =cut