File Coverage

blib/lib/Log/Dispatch/Email/MailSender.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Log::Dispatch::Email::MailSender;
2              
3             # By: Joseph Annino
4             # (c) 2002
5             # Licensed under the same terms as Perl
6             #
7              
8 1     1   482 use strict;
  1         3  
  1         28  
9 1     1   5 use warnings;
  1         3  
  1         38  
10              
11             our $VERSION = '2.70';
12              
13 1     1   6 use Log::Dispatch::Types;
  1         2  
  1         9  
14 1     1   29328 use Mail::Sender ();
  0            
  0            
15             use Params::ValidationCompiler qw( validation_for );
16              
17             use base qw( Log::Dispatch::Email );
18              
19             {
20             my $validator = validation_for(
21             params => {
22             smtp => { default => 'localhost' },
23             port => { default => 25 },
24             authid => 0,
25             authpwd => 0,
26             auth => 0,
27             tls_required => 0,
28             replyto => 0,
29             fake_from => 0,
30             },
31             slurpy => 1,
32             );
33              
34             sub new {
35             my $class = shift;
36             my %p = $validator->(@_);
37              
38             my $smtp = delete $p{smtp};
39             my $port = delete $p{port};
40             my $authid = delete $p{authid};
41             my $authpwd = delete $p{authpwd};
42             my $auth = delete $p{auth};
43             my $tls_required = delete $p{tls_required};
44             my $replyto = delete $p{replyto};
45             my $fake_from = delete $p{fake_from};
46              
47             my $self = $class->SUPER::new(%p);
48              
49             $self->{smtp} = $smtp;
50             $self->{port} = $port;
51              
52             $self->{authid} = $authid;
53             $self->{authpwd} = $authpwd;
54             $self->{auth} = $auth;
55             $self->{tls_required} = $tls_required;
56              
57             $self->{fake_from} = $fake_from;
58             $self->{replyto} = $replyto;
59              
60             return $self;
61             }
62             }
63              
64             sub send_email {
65             my $self = shift;
66             my %p = @_;
67              
68             local ( $?, $@, $SIG{__DIE__} ) = ( 0, undef, undef );
69             return
70             if eval {
71             my $sender = Mail::Sender->new(
72             {
73             from => $self->{from} || 'LogDispatch@foo.bar',
74             fake_from => $self->{fake_from},
75             replyto => $self->{replyto},
76             to => ( join ',', @{ $self->{to} } ),
77             subject => $self->{subject},
78             smtp => $self->{smtp},
79             port => $self->{port},
80             authid => $self->{authid},
81             authpwd => $self->{authpwd},
82             auth => $self->{auth},
83             tls_required => $self->{tls_required},
84              
85             #debug => \*STDERR,
86             }
87             );
88              
89             die "Error sending mail ($sender): $Mail::Sender::Error"
90             unless ref $sender;
91              
92             ref $sender->MailMsg( { msg => $p{message} } )
93             or die "Error sending mail: $Mail::Sender::Error";
94              
95             1;
96             };
97              
98             warn $@ if $@;
99             }
100              
101             1;
102              
103             # ABSTRACT: Subclass of Log::Dispatch::Email that uses the Mail::Sender module
104              
105             __END__
106              
107             =pod
108              
109             =encoding UTF-8
110              
111             =head1 NAME
112              
113             Log::Dispatch::Email::MailSender - Subclass of Log::Dispatch::Email that uses the Mail::Sender module
114              
115             =head1 VERSION
116              
117             version 2.70
118              
119             =head1 SYNOPSIS
120              
121             use Log::Dispatch;
122              
123             my $log = Log::Dispatch->new(
124             outputs => [
125             [
126             'Email::MailSender',
127             min_level => 'emerg',
128             to => [qw( foo@example.com bar@example.org )],
129             subject => 'Big error!'
130             ]
131             ],
132             );
133              
134             $log->emerg("Something bad is happening");
135              
136             =head1 DESCRIPTION
137              
138             This is a subclass of L<Log::Dispatch::Email> that implements the send_email
139             method using the L<Mail::Sender> module.
140              
141             =head1 CONSTRUCTOR
142              
143             The constructor takes the following parameters in addition to the parameters
144             documented in L<Log::Dispatch::Output> and L<Log::Dispatch::Email>:
145              
146             =over 4
147              
148             =item * smtp ($)
149              
150             The smtp server to connect to. This defaults to "localhost".
151              
152             =item * port ($)
153              
154             The port to use when connecting. This defaults to 25.
155              
156             =item * auth ($)
157              
158             Optional. The SMTP authentication protocol to use to login to the server. At
159             the time of writing Mail::Sender only supports LOGIN, PLAIN, CRAM-MD5 and
160             NTLM.
161              
162             Some protocols have module dependencies. CRAM-MD5 depends on Digest::HMAC_MD5
163             and NTLM on Authen::NTLM.
164              
165             =item * authid ($)
166              
167             Optional. The username used to login to the server.
168              
169             =item * authpwd ($)
170              
171             Optional. The password used to login to the server.
172              
173             =item * tls_required ($)
174              
175             Optional. If you set this option to a true value, Mail::Sender will fail
176             whenever it's unable to use TLS.
177              
178             =item * fake_from ($)
179              
180             The From address that will be shown in headers. If not specified we use the
181             value of from.
182              
183             =item * replyto ($)
184              
185             The reply-to address.
186              
187             =back
188              
189             =head1 SUPPORT
190              
191             Bugs may be submitted at L<https://github.com/houseabsolute/Log-Dispatch/issues>.
192              
193             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
194              
195             =head1 SOURCE
196              
197             The source code repository for Log-Dispatch can be found at L<https://github.com/houseabsolute/Log-Dispatch>.
198              
199             =head1 AUTHOR
200              
201             Dave Rolsky <autarch@urth.org>
202              
203             =head1 COPYRIGHT AND LICENSE
204              
205             This software is Copyright (c) 2020 by Dave Rolsky.
206              
207             This is free software, licensed under:
208              
209             The Artistic License 2.0 (GPL Compatible)
210              
211             The full text of the license can be found in the
212             F<LICENSE> file included with this distribution.
213              
214             =cut