line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Email::Send; |
2
|
13
|
|
|
13
|
|
202209
|
use strict; |
|
13
|
|
|
|
|
23
|
|
|
13
|
|
|
|
|
461
|
|
3
|
|
|
|
|
|
|
|
4
|
13
|
|
|
13
|
|
66
|
use vars qw[$VERSION]; |
|
13
|
|
|
|
|
15
|
|
|
13
|
|
|
|
|
751
|
|
5
|
|
|
|
|
|
|
$VERSION = '2.200'; |
6
|
|
|
|
|
|
|
|
7
|
13
|
|
|
13
|
|
5770
|
use Email::Simple 1.92; |
|
13
|
|
|
|
|
48434
|
|
|
13
|
|
|
|
|
451
|
|
8
|
|
|
|
|
|
|
use Module::Pluggable 2.97 |
9
|
13
|
|
|
|
|
82
|
search_path => 'Email::Send', |
10
|
13
|
|
|
13
|
|
6121
|
except => $Email::Send::__plugin_exclusion; |
|
13
|
|
|
|
|
93385
|
|
11
|
|
|
|
|
|
|
BEGIN { |
12
|
13
|
|
|
13
|
|
1232
|
local $Return::Value::NO_CLUCK = 1; |
13
|
13
|
|
|
|
|
5856
|
require Return::Value; |
14
|
13
|
|
|
|
|
35137
|
Return::Value->import; |
15
|
|
|
|
|
|
|
} |
16
|
13
|
|
|
13
|
|
101
|
use Scalar::Util 1.02 (); |
|
13
|
|
|
|
|
317
|
|
|
13
|
|
|
|
|
2369
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Email::Send - Simply Sending Email |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 WAIT! ACHTUNG! |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Email::Send is going away... well, not really going away, but it's being |
25
|
|
|
|
|
|
|
officially marked "out of favor." It has API design problems that make it hard |
26
|
|
|
|
|
|
|
to usefully extend and rather than try to deprecate features and slowly ease in |
27
|
|
|
|
|
|
|
a new interface, we've released Email::SendB which fixes these problems and |
28
|
|
|
|
|
|
|
others. As of today, 2008-12-19, Email::Sender is young, but it's fairly |
29
|
|
|
|
|
|
|
well-tested. Please consider using it instead for any new work. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 SYNOPSIS |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
use Email::Send; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $message = <<'__MESSAGE__'; |
36
|
|
|
|
|
|
|
To: recipient@example.com |
37
|
|
|
|
|
|
|
From: sender@example.com |
38
|
|
|
|
|
|
|
Subject: Hello there folks |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
How are you? Enjoy! |
41
|
|
|
|
|
|
|
__MESSAGE__ |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $sender = Email::Send->new({mailer => 'SMTP'}); |
44
|
|
|
|
|
|
|
$sender->mailer_args([Host => 'smtp.example.com']); |
45
|
|
|
|
|
|
|
$sender->send($message); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# more complex |
48
|
|
|
|
|
|
|
my $bulk = Email::Send->new; |
49
|
|
|
|
|
|
|
for ( qw[SMTP Sendmail Qmail] ) { |
50
|
|
|
|
|
|
|
$bulk->mailer($_) and last if $bulk->mailer_available($_); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
$bulk->message_modifier(sub { |
54
|
|
|
|
|
|
|
my ($sender, $message, $to) = @_; |
55
|
|
|
|
|
|
|
$message->header_set(To => qq[$to\@geeknest.com]) |
56
|
|
|
|
|
|
|
}); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my @to = qw[casey chastity evelina casey_jr marshall]; |
59
|
|
|
|
|
|
|
my $rv = $bulk->send($message, $_) for @to; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 DESCRIPTION |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
This module provides a very simple, very clean, very specific interface |
64
|
|
|
|
|
|
|
to multiple Email mailers. The goal of this software is to be small |
65
|
|
|
|
|
|
|
and simple, easy to use, and easy to extend. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 Constructors |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=over 4 |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item new |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $sender = Email::Send->new({ |
74
|
|
|
|
|
|
|
mailer => 'NNTP', |
75
|
|
|
|
|
|
|
mailer_args => [ Host => 'nntp.example.com' ], |
76
|
|
|
|
|
|
|
}); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Create a new mailer object. This method can take parameters for any of the data |
79
|
|
|
|
|
|
|
properties of this module. Those data properties, which have their own accessors, |
80
|
|
|
|
|
|
|
are listed under L<"Properties">. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=back |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 Properties |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=over 4 |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=item mailer |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
The mailing system you'd like to use for sending messages with this object. |
91
|
|
|
|
|
|
|
This is not defined by default. If you don't specify a mailer, all available |
92
|
|
|
|
|
|
|
plugins will be tried when the C method is called until one succeeds. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item mailer_args |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Arguments passed into the mailing system you're using. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item message_modifier |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
If defined, this callback is invoked every time the C method is called |
101
|
|
|
|
|
|
|
on an object. The mailer object will be passed as the first argument. Second, |
102
|
|
|
|
|
|
|
the actual C object for a message will be passed. Finally, any |
103
|
|
|
|
|
|
|
additional arguments passed to C will be passed to this method in the |
104
|
|
|
|
|
|
|
order they were received. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
This is useful if you are sending in bulk. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=back |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub new { |
113
|
19
|
|
|
19
|
1
|
33611
|
my ($class, $args) = @_; |
114
|
19
|
|
100
|
|
|
133
|
$args->{mailer_args} ||= []; |
115
|
96
|
|
|
|
|
47379
|
my %plugins = map { |
116
|
19
|
|
|
|
|
138
|
my ($short_name) = /^Email::Send::(.+)/; |
117
|
96
|
|
|
|
|
218
|
($short_name, $_); |
118
|
|
|
|
|
|
|
} $class->plugins; |
119
|
19
|
|
|
|
|
69
|
$args->{_plugin_list} = \%plugins; |
120
|
19
|
|
|
|
|
92
|
return bless $args => $class; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
BEGIN { |
124
|
13
|
|
|
13
|
|
25
|
for my $field (qw(mailer mailer_args message_modifier _plugin_list)) { |
125
|
|
|
|
|
|
|
my $code = sub { |
126
|
148
|
100
|
|
148
|
|
1264
|
return $_[0]->{$field} unless @_ > 1; |
127
|
4
|
|
|
|
|
7
|
my $self = shift; |
128
|
4
|
50
|
|
|
|
16
|
$self->{$field} = (@_ == 1 ? $_[0] : [@_]); |
129
|
52
|
|
|
|
|
143
|
}; |
130
|
|
|
|
|
|
|
|
131
|
13
|
|
|
13
|
|
68
|
no strict 'refs'; |
|
13
|
|
|
|
|
18
|
|
|
13
|
|
|
|
|
426
|
|
132
|
52
|
|
|
|
|
7217
|
*$field = $code; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 METHODS |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=over 4 |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item send |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $result = $sender->send($message, @modifier_args); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Send a message using the predetermined mailer and mailer arguments. If you |
145
|
|
|
|
|
|
|
have defined a C it will be called prior to sending. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
The first argument you pass to send is an email message. It must be in some |
148
|
|
|
|
|
|
|
format that C can understand. If you don't have |
149
|
|
|
|
|
|
|
C installed then sending as plain text or an C |
150
|
|
|
|
|
|
|
object will do. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Any remaining arguments will be passed directly into your defined |
153
|
|
|
|
|
|
|
C. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub send { |
158
|
19
|
100
|
|
19
|
1
|
2452
|
goto &_send_function unless eval { $_[0]->isa('Email::Send') }; |
|
19
|
|
|
|
|
189
|
|
159
|
18
|
|
|
|
|
46
|
my ($self, $message, @args) = @_; |
160
|
|
|
|
|
|
|
|
161
|
18
|
|
|
|
|
57
|
my $simple = $self->_objectify_message($message); |
162
|
18
|
100
|
|
|
|
2329
|
return failure "No message found." unless $simple; |
163
|
|
|
|
|
|
|
|
164
|
16
|
100
|
|
|
|
56
|
$self->message_modifier->( |
165
|
|
|
|
|
|
|
$self, $simple, |
166
|
|
|
|
|
|
|
@args, |
167
|
|
|
|
|
|
|
) if $self->message_modifier; |
168
|
|
|
|
|
|
|
|
169
|
16
|
100
|
|
|
|
118
|
if ( $self->mailer ) { |
170
|
14
|
|
|
|
|
39
|
return $self->_send_it($self->mailer, $simple); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
2
|
|
|
|
|
5
|
return $self->_try_all($simple); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=item all_mailers |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my @available = $sender->all_mailers; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Returns a list of available mailers. These are mailers that are |
181
|
|
|
|
|
|
|
installed on your computer and register themselves as available. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub all_mailers { |
186
|
3
|
|
|
3
|
1
|
9
|
my ($self) = @_; |
187
|
3
|
|
|
|
|
3
|
my @mailers; |
188
|
3
|
|
|
|
|
3
|
for ( keys %{$self->_plugin_list} ) { |
|
3
|
|
|
|
|
7
|
|
189
|
7
|
100
|
|
|
|
145
|
push @mailers, $_ if $self->mailer_available($_); |
190
|
|
|
|
|
|
|
} |
191
|
3
|
|
|
|
|
125
|
return @mailers; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item mailer_available |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# is SMTP over SSL avaialble? |
197
|
|
|
|
|
|
|
$sender->mailer('SMTP') |
198
|
|
|
|
|
|
|
if $sender->mailer_available('SMTP', ssl => 1); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Given the name of a mailer, such as C, determine if it is |
201
|
|
|
|
|
|
|
available. Any additional arguments passed to this method are passed |
202
|
|
|
|
|
|
|
directly to the C method of the mailer being queried. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=back |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=cut |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub mailer_available { |
209
|
25
|
|
|
25
|
1
|
48
|
my ($self, $mailer, @args) = @_; |
210
|
|
|
|
|
|
|
|
211
|
25
|
|
|
|
|
54
|
my $invocant = $self->_mailer_invocant($mailer); |
212
|
|
|
|
|
|
|
|
213
|
25
|
100
|
|
|
|
167
|
return $invocant unless $invocant; |
214
|
|
|
|
|
|
|
|
215
|
22
|
100
|
|
|
|
237
|
$invocant->can('is_available') |
216
|
|
|
|
|
|
|
or return failure "Mailer $mailer doesn't report availability."; |
217
|
|
|
|
|
|
|
|
218
|
21
|
|
|
|
|
75
|
my $test = $invocant->is_available(@args); |
219
|
21
|
100
|
|
|
|
335
|
return $test unless $test; |
220
|
20
|
|
|
|
|
229
|
return success; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub _objectify_message { |
224
|
18
|
|
|
18
|
|
42
|
my ($self, $message) = @_; |
225
|
|
|
|
|
|
|
|
226
|
18
|
100
|
|
|
|
76
|
return undef unless defined $message; |
227
|
17
|
100
|
|
|
|
124
|
return $message if UNIVERSAL::isa($message, 'Email::Simple'); |
228
|
15
|
100
|
|
|
|
114
|
return Email::Simple->new($message) unless ref($message); |
229
|
|
|
|
|
|
|
return Email::Abstract->cast($message => 'Email::Simple') |
230
|
2
|
100
|
|
|
|
3
|
if eval { require Email::Abstract }; |
|
2
|
|
|
|
|
410
|
|
231
|
1
|
|
|
|
|
22
|
return undef; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub _mailer_invocant { |
235
|
43
|
|
|
43
|
|
396
|
my ($self, $mailer) = @_; |
236
|
|
|
|
|
|
|
|
237
|
43
|
100
|
|
|
|
156
|
return $mailer if Scalar::Util::blessed($mailer); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# is the mailer a plugin given by short name? |
240
|
39
|
100
|
|
|
|
86
|
my $package = exists $self->_plugin_list->{$mailer} |
241
|
|
|
|
|
|
|
? $self->_plugin_list->{$mailer} |
242
|
|
|
|
|
|
|
: $mailer; |
243
|
|
|
|
|
|
|
|
244
|
39
|
100
|
|
|
|
2315
|
eval "require $package" or return failure "$@"; |
245
|
|
|
|
|
|
|
|
246
|
36
|
|
|
|
|
603
|
return $package; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub _send_it { |
250
|
16
|
|
|
16
|
|
35
|
my ($self, $mailer, $message) = @_; |
251
|
16
|
|
|
|
|
46
|
my $test = $self->mailer_available($mailer); |
252
|
16
|
100
|
|
|
|
603
|
return $test unless $test; |
253
|
|
|
|
|
|
|
|
254
|
14
|
|
|
|
|
377
|
my $invocant = $self->_mailer_invocant($mailer); |
255
|
|
|
|
|
|
|
|
256
|
14
|
|
|
|
|
21
|
return $invocant->send($message, @{$self->mailer_args}); |
|
14
|
|
|
|
|
37
|
|
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub _try_all { |
260
|
2
|
|
|
2
|
|
3
|
my ($self, $simple) = @_; |
261
|
2
|
|
|
|
|
5
|
foreach ( $self->all_mailers ) { |
262
|
2
|
50
|
|
|
|
5
|
next if $_ eq 'Email::Send::Test'; |
263
|
2
|
|
|
|
|
5
|
my $sent = $self->_send_it($_, $simple); |
264
|
2
|
100
|
|
|
|
24
|
return $sent if $sent; |
265
|
|
|
|
|
|
|
} |
266
|
1
|
|
|
|
|
18
|
return failure "Unable to send message."; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# Classic Interface. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub import { |
272
|
13
|
|
|
13
|
|
89
|
no strict 'refs'; |
|
13
|
|
|
|
|
21
|
|
|
13
|
|
|
|
|
1167
|
|
273
|
13
|
|
|
13
|
|
1037
|
*{(caller)[0] . '::send'} = __PACKAGE__->can('_send_function'); |
|
13
|
|
|
|
|
2420
|
|
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub _send_function { |
277
|
6
|
|
|
6
|
|
95584
|
my ($mailer, $message, @args) = @_; |
278
|
6
|
|
|
|
|
60
|
__PACKAGE__->new({ |
279
|
|
|
|
|
|
|
mailer => $mailer, |
280
|
|
|
|
|
|
|
mailer_args => \@args, |
281
|
|
|
|
|
|
|
})->send($message); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
1; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
__END__ |