1package Log::Dispatch::Email;
2{
3  $Log::Dispatch::Email::VERSION = '2.34';
4}
5
6use strict;
7use warnings;
8
9use Log::Dispatch::Output;
10
11use base qw( Log::Dispatch::Output );
12
13use Params::Validate qw(validate SCALAR ARRAYREF BOOLEAN);
14Params::Validate::validation_options( allow_extra => 1 );
15
16# need to untaint this value
17my ($program) = $0 =~ /(.+)/;
18
19sub new {
20    my $proto = shift;
21    my $class = ref $proto || $proto;
22
23    my %p = validate(
24        @_, {
25            subject => {
26                type    => SCALAR,
27                default => "$program: log email"
28            },
29            to   => { type => SCALAR | ARRAYREF },
30            from => {
31                type     => SCALAR,
32                optional => 1
33            },
34            buffered => {
35                type    => BOOLEAN,
36                default => 1
37            },
38        }
39    );
40
41    my $self = bless {}, $class;
42
43    $self->_basic_init(%p);
44
45    $self->{subject} = $p{subject} || "$0: log email";
46    $self->{to} = ref $p{to} ? $p{to} : [ $p{to} ];
47    $self->{from} = $p{from};
48
49    # Default to buffered for obvious reasons!
50    $self->{buffered} = $p{buffered};
51
52    $self->{buffer} = [] if $self->{buffered};
53
54    return $self;
55}
56
57sub log_message {
58    my $self = shift;
59    my %p    = @_;
60
61    if ( $self->{buffered} ) {
62        push @{ $self->{buffer} }, $p{message};
63    }
64    else {
65        $self->send_email(@_);
66    }
67}
68
69sub send_email {
70    my $self  = shift;
71    my $class = ref $self;
72
73    die "The send_email method must be overridden in the $class subclass";
74}
75
76sub flush {
77    my $self = shift;
78
79    if ( $self->{buffered} && @{ $self->{buffer} } ) {
80        my $message = join '', @{ $self->{buffer} };
81
82        $self->send_email( message => $message );
83        $self->{buffer} = [];
84    }
85}
86
87sub DESTROY {
88    my $self = shift;
89
90    $self->flush;
91}
92
931;
94
95# ABSTRACT: Base class for objects that send log messages via email
96
97__END__
98
99=pod
100
101=head1 NAME
102
103Log::Dispatch::Email - Base class for objects that send log messages via email
104
105=head1 VERSION
106
107version 2.34
108
109=head1 SYNOPSIS
110
111  package Log::Dispatch::Email::MySender;
112
113  use Log::Dispatch::Email;
114  use base qw( Log::Dispatch::Email );
115
116  sub send_email {
117      my $self = shift;
118      my %p    = @_;
119
120      # Send email somehow.  Message is in $p{message}
121  }
122
123=head1 DESCRIPTION
124
125This module should be used as a base class to implement
126Log::Dispatch::* objects that send their log messages via email.
127Implementing a subclass simply requires the code shown in the
128L<SYNOPSIS> with a real implementation of the C<send_email()> method.
129
130=head1 CONSTRUCTOR
131
132The constructor takes the following parameters in addition to the standard
133parameters documented in L<Log::Dispatch::Output>:
134
135=over 4
136
137=item * subject ($)
138
139The subject of the email messages which are sent.  Defaults to "$0:
140log email"
141
142=item * to ($ or \@)
143
144Either a string or a list reference of strings containing email
145addresses.  Required.
146
147=item * from ($)
148
149A string containing an email address.  This is optional and may not
150work with all mail sending methods.
151
152=item * buffered (0 or 1)
153
154This determines whether the object sends one email per message it is
155given or whether it stores them up and sends them all at once.  The
156default is to buffer messages.
157
158=back
159
160=head1 METHODS
161
162=over 4
163
164=item * send_email(%p)
165
166This is the method that must be subclassed.  For now the only
167parameter in the hash is 'message'.
168
169=item * flush
170
171If the object is buffered, then this method will call the
172C<send_email()> method to send the contents of the buffer and then
173clear the buffer.
174
175=item * DESTROY
176
177On destruction, the object will call C<flush()> to send any pending
178email.
179
180=back
181
182=head1 AUTHOR
183
184Dave Rolsky <autarch@urth.org>
185
186=head1 COPYRIGHT AND LICENSE
187
188This software is Copyright (c) 2011 by Dave Rolsky.
189
190This is free software, licensed under:
191
192  The Artistic License 2.0 (GPL Compatible)
193
194=cut
195