line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
XAO::DO::Web::Mailer - executes given template and sends results via e-mail |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
<%Mailer |
8
|
|
|
|
|
|
|
to="foo@somehost.com" |
9
|
|
|
|
|
|
|
from="bar@otherhost.com" |
10
|
|
|
|
|
|
|
subject="Your order '<%ORDER_ID/f%>' has been shipped" |
11
|
|
|
|
|
|
|
text.path="/bits/shipped-mail-text" |
12
|
|
|
|
|
|
|
html.path="/bits/shipped-mail-html" |
13
|
|
|
|
|
|
|
ORDER_ID="<%ORDER_ID/f%>" |
14
|
|
|
|
|
|
|
%> |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 DESCRIPTION |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Displays nothing, just sends message. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Arguments are: |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
to => e-mail address of the recepient; default is taken from |
23
|
|
|
|
|
|
|
userdata->email if defined. |
24
|
|
|
|
|
|
|
cc => optional e-mail addresses of secondary recepients |
25
|
|
|
|
|
|
|
bcc => optional e-mail addresses of blind CC recepients |
26
|
|
|
|
|
|
|
from => optional 'from' e-mail address, default is taken from |
27
|
|
|
|
|
|
|
'from' site configuration parameter. |
28
|
|
|
|
|
|
|
subject => message subject; |
29
|
|
|
|
|
|
|
[text.]path => text-only template path (required); |
30
|
|
|
|
|
|
|
html.path => html template path; |
31
|
|
|
|
|
|
|
date => optional date header, passed as is; |
32
|
|
|
|
|
|
|
pass => pass parameters of the calling template to the mail template; |
33
|
|
|
|
|
|
|
ARG => VALUE - passed to Page when executing templates; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
If 'to', 'from' or 'subject' are not specified then get_to(), get_from() |
36
|
|
|
|
|
|
|
or get_subject() methods are called first. Derived class may override |
37
|
|
|
|
|
|
|
them. 'To', 'cc' and 'bcc' may be comma-separated addresses lists. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
To send additional attachments along with the email pass the following |
40
|
|
|
|
|
|
|
arguments (where N can be any alphanumeric tag): |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
attachment.N.type => MIME type for attachment (image/gif, text/plain, etc) |
43
|
|
|
|
|
|
|
attachment.N.filename => download filename for the attachment (optional) |
44
|
|
|
|
|
|
|
attachment.N.disposition => attachment disposition (optional, 'attachment' by default) |
45
|
|
|
|
|
|
|
attachment.N.path => path to a template for building the attachment |
46
|
|
|
|
|
|
|
attachment.N.template => inline template for building the attachment |
47
|
|
|
|
|
|
|
attachment.N.unparsed => use the template literally, without xao-parsing |
48
|
|
|
|
|
|
|
attachment.N.pass => pass all arguments of the calling template |
49
|
|
|
|
|
|
|
attachment.N.ARG => VALUE - passed literally as ARG=>VALUE to the template |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
The configuration for Web::Mailer is kept in a hash stored in the site |
52
|
|
|
|
|
|
|
configuration under 'mailer' name. Normally it is not required, the |
53
|
|
|
|
|
|
|
default is to use sendmail for delivery. The parameters are: |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
method => either 'local' or 'smtp' |
56
|
|
|
|
|
|
|
agent => server name for `smtp' or binary path for `local' |
57
|
|
|
|
|
|
|
from => either a hash reference or a scalar with the default |
58
|
|
|
|
|
|
|
`from' address. |
59
|
|
|
|
|
|
|
override_from |
60
|
|
|
|
|
|
|
=> if set overrides the from address |
61
|
|
|
|
|
|
|
override_to |
62
|
|
|
|
|
|
|
=> if set overrides all to addresses and always sends to |
63
|
|
|
|
|
|
|
the given address. Useful for debugging. |
64
|
|
|
|
|
|
|
override_except |
65
|
|
|
|
|
|
|
=> addresses listed here are OK to go through. Matching |
66
|
|
|
|
|
|
|
is done on substrings ingoring case. This options makes |
67
|
|
|
|
|
|
|
sense only in pair with override_to. |
68
|
|
|
|
|
|
|
subject_prefix |
69
|
|
|
|
|
|
|
=> optional fixed prefix for all subjects |
70
|
|
|
|
|
|
|
subject_suffix |
71
|
|
|
|
|
|
|
=> optional fixed suffix for all subjects |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
If `from' is a hash reference then the content of `from' argument to the |
74
|
|
|
|
|
|
|
object is looked in keys and the value is used as actual `from' |
75
|
|
|
|
|
|
|
address. This can be used to set up rudimentary aliases: |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
<%Mailer |
78
|
|
|
|
|
|
|
... |
79
|
|
|
|
|
|
|
from="customer_support" |
80
|
|
|
|
|
|
|
... |
81
|
|
|
|
|
|
|
%> |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
mailer => { |
84
|
|
|
|
|
|
|
from => { |
85
|
|
|
|
|
|
|
customer_support => 'support@foo.com', |
86
|
|
|
|
|
|
|
technical_support => 'tech@foo.com', |
87
|
|
|
|
|
|
|
}, |
88
|
|
|
|
|
|
|
... |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
In that case actual from address will be `support@foo.com'. By default |
92
|
|
|
|
|
|
|
if `from' in the configuration is a hash and there is no `from' |
93
|
|
|
|
|
|
|
parameter for the object, `default' is used as the key. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
############################################################################### |
98
|
|
|
|
|
|
|
package XAO::DO::Web::Mailer; |
99
|
1
|
|
|
1
|
|
1442
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
100
|
1
|
|
|
1
|
|
4
|
use Encode; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
60
|
|
101
|
1
|
|
|
1
|
|
674
|
use MIME::Lite 2.117; |
|
1
|
|
|
|
|
19262
|
|
|
1
|
|
|
|
|
26
|
|
102
|
1
|
|
|
1
|
|
6
|
use XAO::Objects; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
103
|
1
|
|
|
1
|
|
4
|
use XAO::Utils; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
54
|
|
104
|
1
|
|
|
1
|
|
5
|
use base XAO::Objects->load(objname => 'Web::Page'); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
our $VERSION='2.011'; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub display ($;%) { |
109
|
13
|
|
|
13
|
1
|
56
|
my $self=shift; |
110
|
13
|
|
|
|
|
38
|
my $args=get_args(\@_); |
111
|
|
|
|
|
|
|
|
112
|
13
|
|
50
|
|
|
111
|
my $config=$self->siteconfig->get('/mailer') || {}; |
113
|
|
|
|
|
|
|
|
114
|
13
|
|
33
|
|
|
621
|
my $to=$args->{'to'} || |
115
|
|
|
|
|
|
|
$self->get_to($args) || |
116
|
|
|
|
|
|
|
throw $self "display - no 'to' given"; |
117
|
|
|
|
|
|
|
|
118
|
13
|
|
100
|
|
|
130
|
my $cc=$args->{'cc'} || ''; |
119
|
13
|
|
100
|
|
|
52
|
my $bcc=$args->{'bcc'} || ''; |
120
|
|
|
|
|
|
|
|
121
|
13
|
|
|
|
|
15
|
my @ovhdr; |
122
|
13
|
100
|
|
|
|
30
|
if(my $override_to=$config->{'override_to'}) { |
123
|
3
|
|
|
|
|
14
|
my $to_new; |
124
|
|
|
|
|
|
|
|
125
|
3
|
50
|
|
|
|
15
|
if(my $override_except=$config->{'override_except'}) { |
126
|
0
|
0
|
|
|
|
0
|
$override_except=[ split(/\s*[,;]\s*/,$override_except) ] unless ref($override_except) eq 'ARRAY'; |
127
|
0
|
|
|
|
|
0
|
$override_except=[ map { lc } @$override_except ]; |
|
0
|
|
|
|
|
0
|
|
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
0
|
my %pass; |
130
|
|
|
|
|
|
|
my %override; |
131
|
0
|
|
|
|
|
0
|
foreach my $email (split(/\s*[,;]+\s*/,"$to,$cc,$bcc")) { |
132
|
0
|
0
|
|
|
|
0
|
if(grep { index(lc($email),$_)>=0 } @$override_except) { |
|
0
|
|
|
|
|
0
|
|
133
|
0
|
|
|
|
|
0
|
$pass{$email}=1; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
else { |
136
|
0
|
|
|
|
|
0
|
$override{$email}=1; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
0
|
0
|
|
|
|
0
|
$to_new=join(', ',(keys %pass),(%override ? ($override_to) : ())); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
else { |
143
|
3
|
|
|
|
|
11
|
$to_new=$override_to; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
3
|
|
|
|
|
33
|
dprint ref($self)."::display - overriding to='$to', cc='$cc', bcc='$bcc' with to='$to_new', cc='', bcc=''"; |
147
|
|
|
|
|
|
|
|
148
|
3
|
50
|
|
|
|
67
|
push(@ovhdr,('X-XAO-Web-Mailer-To' => $to)) if $to; |
149
|
3
|
100
|
|
|
|
20
|
push(@ovhdr,('X-XAO-Web-Mailer-Cc' => $cc)) if $cc; |
150
|
3
|
100
|
|
|
|
13
|
push(@ovhdr,('X-XAO-Web-Mailer-Bcc' => $bcc)) if $bcc; |
151
|
|
|
|
|
|
|
|
152
|
3
|
|
|
|
|
8
|
$to=$to_new; |
153
|
3
|
|
|
|
|
11
|
$cc=''; |
154
|
3
|
|
|
|
|
7
|
$bcc=''; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
13
|
|
|
|
|
25
|
my $from=$args->{'from'}; |
158
|
13
|
100
|
|
|
|
23
|
if(!$from) { |
159
|
3
|
|
|
|
|
9
|
$from=$config->{'from'}; |
160
|
3
|
50
|
|
|
|
9
|
$from=$from->{'default'} if ref($from); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
else { |
163
|
|
|
|
|
|
|
$from=$config->{'from'}->{$from} if ref($config->{'from'}) && |
164
|
10
|
0
|
33
|
|
|
22
|
$config->{'from'}->{$from}; |
165
|
|
|
|
|
|
|
} |
166
|
13
|
50
|
|
|
|
24
|
$from || throw $self "display - no 'from' given"; |
167
|
|
|
|
|
|
|
|
168
|
13
|
50
|
|
|
|
24
|
if(my $override_from=$config->{'override_from'}) { |
169
|
0
|
0
|
|
|
|
0
|
if($override_from ne $from) { |
170
|
0
|
|
|
|
|
0
|
dprint ref($self)."::display - overriding from='$from' with '$override_from'"; |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
0
|
push(@ovhdr,('X-XAO-Web-Mailer-From' => $from)); |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
0
|
$from=$override_from; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
13
|
|
|
|
|
18
|
my $from_hdr=$from; |
179
|
13
|
50
|
|
|
|
134
|
if($from =~ /^\s*.*\s+<(.*\@.*)>\s*$/) { |
|
|
50
|
|
|
|
|
|
180
|
0
|
|
|
|
|
0
|
$from=$1; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
elsif($from =~ /^\s*(.*\@.*)\s+\(.*\)\s*$/) { |
183
|
0
|
|
|
|
|
0
|
$from=$1; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
else { |
186
|
13
|
|
|
|
|
83
|
$from=~s/^\s*(.*?)\s*$/$1/; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
13
|
|
50
|
|
|
88
|
my $subject=$args->{'subject'} || $self->get_subject() || 'No subject'; |
190
|
|
|
|
|
|
|
|
191
|
13
|
100
|
|
|
|
41
|
if(my $subject_prefix=$config->{'subject_prefix'}) { |
192
|
1
|
50
|
|
|
|
28
|
$subject=$subject_prefix.($subject_prefix=~/\s$/ ? '':' ').$subject; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
13
|
50
|
|
|
|
38
|
if(my $subject_suffix=$config->{'subject_suffix'}) { |
196
|
0
|
0
|
|
|
|
0
|
$subject=$subject.($subject_suffix=~/\s$/ ? '':' ').$subject_suffix; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# Charset for outgoing mail. Either /mailer/charset or /charset |
200
|
|
|
|
|
|
|
# |
201
|
13
|
|
100
|
|
|
89
|
my $charset=$config->{'charset'} || $self->siteconfig->get('charset') || undef; |
202
|
|
|
|
|
|
|
### dprint "...mailer charset=",$charset; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Subject might contain 8-bit characters, but being a header it |
205
|
|
|
|
|
|
|
# needs to be 7-bit. MIME::Lite does not do that. |
206
|
|
|
|
|
|
|
# |
207
|
13
|
100
|
|
|
|
545
|
if(Encode::is_utf8($subject)) { |
208
|
3
|
|
|
|
|
43
|
$subject=Encode::encode('MIME-Q',$subject); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# The output from MIME-Q is a multi-line string separated by \r\n |
211
|
|
|
|
|
|
|
# and that \r appears to be duplicated by some MTA implementations. |
212
|
|
|
|
|
|
|
# The rest of MIME::Lite headers are output with \n, so sticking to |
213
|
|
|
|
|
|
|
# that. |
214
|
|
|
|
|
|
|
# |
215
|
3
|
|
|
|
|
7888
|
$subject=~s/\r//sg; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Encoding by default in MIME::Lite is "binary", which means no |
219
|
|
|
|
|
|
|
# processing at all. That might break on some gateway and MIME |
220
|
|
|
|
|
|
|
# validator at https://tools.ietf.org/tools/msglint/ balks |
221
|
|
|
|
|
|
|
# at it. Keeping "binary" here for compatibility with older |
222
|
|
|
|
|
|
|
# deployments, but allowing to override it. |
223
|
|
|
|
|
|
|
# |
224
|
13
|
|
100
|
|
|
65
|
my $transfer_encoding=$config->{'transfer_encoding'} || 'binary'; |
225
|
|
|
|
|
|
|
### dprint "...mailer transfer_encoding=",$transfer_encoding; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# Getting common args from the parent template if needed. |
228
|
|
|
|
|
|
|
# |
229
|
13
|
|
|
|
|
151
|
my $common=$self->pass_args($args->{'pass'}); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# Parsing text template |
232
|
|
|
|
|
|
|
# |
233
|
13
|
|
|
|
|
47
|
my $page=$self->object; |
234
|
13
|
|
|
|
|
927
|
my $text; |
235
|
13
|
100
|
33
|
|
|
169
|
if($args->{'text.path'} || $args->{'path'} || $args->{'text.template'} || $args->{'template'}) { |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
236
|
|
|
|
|
|
|
$text=$page->expand($args,$common,{ |
237
|
|
|
|
|
|
|
path => $args->{'text.path'} || $args->{'path'}, |
238
|
9
|
|
33
|
|
|
114
|
template => $args->{'text.template'} || $args->{'template'}, |
|
|
|
66
|
|
|
|
|
239
|
|
|
|
|
|
|
}); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Parsing HTML template |
243
|
|
|
|
|
|
|
# |
244
|
13
|
|
|
|
|
30
|
my $html; |
245
|
13
|
100
|
100
|
|
|
104
|
if($args->{'html.path'} || $args->{'html.template'}) { |
246
|
|
|
|
|
|
|
$html=$page->expand($args,$common,{ |
247
|
|
|
|
|
|
|
path => $args->{'html.path'}, |
248
|
8
|
|
|
|
|
64
|
template => $args->{'html.template'}, |
249
|
|
|
|
|
|
|
}); |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
13
|
50
|
66
|
|
|
93
|
defined $text || defined $html || |
253
|
|
|
|
|
|
|
throw $self "- no text for either html or text part"; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Preparing attachments if any |
256
|
|
|
|
|
|
|
# |
257
|
13
|
|
|
|
|
25
|
my @attachments; |
258
|
13
|
|
|
|
|
74
|
foreach my $k (sort keys %$args) { |
259
|
91
|
100
|
|
|
|
243
|
next unless $k=~/^attachment\.(\w+)\.type$/; |
260
|
9
|
|
|
|
|
54
|
my $id=$1; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
my %data=( |
263
|
|
|
|
|
|
|
Type => $args->{$k}, |
264
|
|
|
|
|
|
|
Filename => $args->{'attachment.'.$id.'.filename'} || '', |
265
|
9
|
|
100
|
|
|
144
|
Disposition => $args->{'attachment.'.$id.'.disposition'} || 'attachment', |
|
|
|
50
|
|
|
|
|
266
|
|
|
|
|
|
|
); |
267
|
|
|
|
|
|
|
|
268
|
9
|
50
|
66
|
|
|
64
|
if($args->{'attachment.'.$id.'.template'} || $args->{'attachment.'.$id.'.path'}) { |
|
|
0
|
|
|
|
|
|
269
|
9
|
|
|
|
|
20
|
my $objargs={ }; |
270
|
9
|
|
|
|
|
26
|
foreach my $kk (keys %$args) { |
271
|
112
|
100
|
|
|
|
464
|
next unless $kk =~ /^attachment\.$id\.(.*)$/; |
272
|
35
|
|
|
|
|
111
|
$objargs->{$1}=$args->{$kk}; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
9
|
|
|
|
|
38
|
my $content; |
276
|
9
|
50
|
|
|
|
27
|
if($args->{'attachment.'.$id.'.unparsed'}) { |
277
|
9
|
100
|
|
|
|
24
|
if(defined $args->{'attachment.'.$id.'.template'}) { |
|
|
50
|
|
|
|
|
|
278
|
7
|
|
|
|
|
18
|
$content=$args->{'attachment.'.$id.'.template'}; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
elsif(defined $args->{'attachment.'.$id.'.path'}) { |
281
|
|
|
|
|
|
|
$content=$self->object->expand( |
282
|
2
|
|
|
|
|
12
|
path => $args->{'attachment.'.$id.'.path'}, |
283
|
|
|
|
|
|
|
unparsed => 1, |
284
|
|
|
|
|
|
|
); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
else { |
288
|
0
|
|
0
|
|
|
0
|
my $obj=$self->object(objname => ($objargs->{'objname'} || 'Page')); |
289
|
0
|
|
|
|
|
0
|
delete $objargs->{'objname'}; |
290
|
|
|
|
|
|
|
|
291
|
0
|
0
|
|
|
|
0
|
if($args->{'attachment.'.$id.'.pass'}) { |
292
|
0
|
|
|
|
|
0
|
$objargs=$self->pass_args($args->{'attachment.'.$id.'.pass'},$objargs); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
0
|
$content=$obj->expand($objargs); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# The content should be bytes, but if it is in |
299
|
|
|
|
|
|
|
# characters it needs to be converted or MIME::Lite will |
300
|
|
|
|
|
|
|
# croak. |
301
|
|
|
|
|
|
|
# |
302
|
9
|
100
|
50
|
|
|
42
|
$content=Encode::encode($charset || 'utf8',$content) if utf8::is_utf8($content); |
303
|
|
|
|
|
|
|
|
304
|
9
|
|
|
|
|
84
|
$data{'Data'}=$content; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
elsif($args->{'attachment.'.$id.'.file'}) { |
307
|
0
|
|
|
|
|
0
|
throw $self "- attaching files not implemented"; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
else { |
310
|
0
|
|
|
|
|
0
|
throw $self "- no path/template/file given for attachment '$id'"; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
9
|
|
|
|
|
20
|
push(@attachments,\%data); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# Preparing mailer and storing content in. |
317
|
|
|
|
|
|
|
# |
318
|
|
|
|
|
|
|
# MIME::Lite does not do anything with encoding and does not really |
319
|
|
|
|
|
|
|
# support perl unicode. It does not apply any filtering to its |
320
|
|
|
|
|
|
|
# output streams. With that in mind, we need to supply it with |
321
|
|
|
|
|
|
|
# bytes, so doing our own encoding. |
322
|
|
|
|
|
|
|
# |
323
|
|
|
|
|
|
|
# Thanks Brian Mielke for catching this! |
324
|
|
|
|
|
|
|
# |
325
|
|
|
|
|
|
|
# TODO: Switch to Email::MIME instead of MIME::Lite! |
326
|
|
|
|
|
|
|
# |
327
|
13
|
100
|
100
|
|
|
128
|
my @stdhdr=( |
328
|
|
|
|
|
|
|
From => $from_hdr, |
329
|
|
|
|
|
|
|
FromSender => $from, |
330
|
|
|
|
|
|
|
To => $to, |
331
|
|
|
|
|
|
|
Subject => $charset && utf8::is_utf8($subject) ? Encode::encode($charset,$subject) : $subject, |
332
|
|
|
|
|
|
|
); |
333
|
|
|
|
|
|
|
|
334
|
13
|
|
|
|
|
280
|
push(@stdhdr,@ovhdr); |
335
|
|
|
|
|
|
|
|
336
|
13
|
|
|
|
|
15
|
my $mailer; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# Simple case, HTML only, no attachments |
339
|
|
|
|
|
|
|
# |
340
|
13
|
100
|
100
|
|
|
139
|
if(defined $html && !defined $text && !@attachments) { |
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
341
|
3
|
50
|
33
|
|
|
51
|
$mailer=MIME::Lite->new( |
342
|
|
|
|
|
|
|
@stdhdr, |
343
|
|
|
|
|
|
|
Type => 'text/html', |
344
|
|
|
|
|
|
|
Data => $charset && utf8::is_utf8($html) ? Encode::encode($charset,$html) : $html, |
345
|
|
|
|
|
|
|
Datestamp => 0, |
346
|
|
|
|
|
|
|
Encoding => $transfer_encoding, |
347
|
|
|
|
|
|
|
); |
348
|
3
|
50
|
|
|
|
927
|
$mailer->attr('content-type.charset' => $charset) if $charset; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
# TEXT only, no attachments |
352
|
|
|
|
|
|
|
# |
353
|
|
|
|
|
|
|
elsif(defined $text && !defined $html && !@attachments) { |
354
|
4
|
50
|
66
|
|
|
53
|
$mailer=MIME::Lite->new( |
355
|
|
|
|
|
|
|
@stdhdr, |
356
|
|
|
|
|
|
|
Type => 'text/plain', |
357
|
|
|
|
|
|
|
Data => $charset && utf8::is_utf8($text) ? Encode::encode($charset,$text) : $text, |
358
|
|
|
|
|
|
|
Datestamp => 0, |
359
|
|
|
|
|
|
|
Encoding => $transfer_encoding, |
360
|
|
|
|
|
|
|
); |
361
|
4
|
100
|
|
|
|
1209
|
$mailer->attr('content-type.charset' => $charset) if $charset; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
# HTML, TEXT, and/or attachments |
365
|
|
|
|
|
|
|
# |
366
|
|
|
|
|
|
|
else { |
367
|
6
|
|
|
|
|
23
|
my $text_part; |
368
|
6
|
100
|
|
|
|
18
|
if(defined $text) { |
369
|
5
|
50
|
33
|
|
|
82
|
$text_part=MIME::Lite->new( |
370
|
|
|
|
|
|
|
Type => 'text/plain', |
371
|
|
|
|
|
|
|
Data => $charset && utf8::is_utf8($text) ? Encode::encode($charset,$text) : $text, |
372
|
|
|
|
|
|
|
Encoding => $transfer_encoding, |
373
|
|
|
|
|
|
|
); |
374
|
|
|
|
|
|
|
|
375
|
5
|
|
|
|
|
5372
|
$text_part->delete('X-Mailer'); |
376
|
5
|
|
|
|
|
78
|
$text_part->delete('Date'); |
377
|
|
|
|
|
|
|
|
378
|
5
|
50
|
|
|
|
82
|
$text_part->attr('content-type.charset' => $charset) if $charset; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
6
|
|
|
|
|
114
|
my $html_part; |
382
|
6
|
100
|
|
|
|
16
|
if(defined $html) { |
383
|
5
|
50
|
33
|
|
|
59
|
$html_part=MIME::Lite->new( |
384
|
|
|
|
|
|
|
Type => 'text/html', |
385
|
|
|
|
|
|
|
Data => $charset && utf8::is_utf8($html) ? Encode::encode($charset,$html) : $html, |
386
|
|
|
|
|
|
|
Encoding => $transfer_encoding, |
387
|
|
|
|
|
|
|
); |
388
|
|
|
|
|
|
|
|
389
|
5
|
|
|
|
|
1343
|
$html_part->delete('X-Mailer'); |
390
|
5
|
|
|
|
|
76
|
$html_part->delete('Date'); |
391
|
|
|
|
|
|
|
|
392
|
5
|
50
|
|
|
|
68
|
$html_part->attr('content-type.charset' => $charset) if $charset; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
6
|
100
|
|
|
|
107
|
$mailer=MIME::Lite->new( |
396
|
|
|
|
|
|
|
@stdhdr, |
397
|
|
|
|
|
|
|
Type => @attachments ? 'multipart/mixed' : 'multipart/alternative', |
398
|
|
|
|
|
|
|
Datestamp => 0, |
399
|
|
|
|
|
|
|
); |
400
|
|
|
|
|
|
|
|
401
|
6
|
100
|
100
|
|
|
49068
|
if($text_part && $html_part && @attachments) { |
|
|
|
100
|
|
|
|
|
402
|
3
|
|
|
|
|
26
|
my $alt_part=MIME::Lite->new( |
403
|
|
|
|
|
|
|
Type => 'multipart/alternative', |
404
|
|
|
|
|
|
|
Datestamp => 0, |
405
|
|
|
|
|
|
|
); |
406
|
|
|
|
|
|
|
|
407
|
3
|
|
|
|
|
567
|
$alt_part->delete('X-Mailer'); |
408
|
3
|
|
|
|
|
46
|
$alt_part->delete('Date'); |
409
|
|
|
|
|
|
|
|
410
|
3
|
|
|
|
|
38
|
$alt_part->attach($text_part); |
411
|
3
|
|
|
|
|
42
|
$alt_part->attach($html_part); |
412
|
|
|
|
|
|
|
|
413
|
3
|
|
|
|
|
28
|
$mailer->attach($alt_part); |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
else { |
416
|
3
|
100
|
|
|
|
24
|
$mailer->attach($text_part) if $text_part; |
417
|
3
|
100
|
|
|
|
40
|
$mailer->attach($html_part) if $html_part; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# Adding attachments if any |
421
|
|
|
|
|
|
|
# |
422
|
6
|
|
|
|
|
60
|
foreach my $adata (@attachments) { |
423
|
9
|
|
|
|
|
1013
|
$mailer->attach(%$adata); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
13
|
50
|
|
|
|
1333
|
$mailer->add(Date => $args->{'date'}) if $args->{'date'}; |
428
|
13
|
50
|
|
|
|
26
|
$mailer->add(Cc => $cc) if $cc; |
429
|
13
|
50
|
|
|
|
21
|
$mailer->add(Bcc => $bcc) if $bcc; |
430
|
13
|
100
|
|
|
|
29
|
$mailer->add('Reply-To' => $args->{'replyto'}) if $args->{'replyto'}; |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# Sending |
433
|
|
|
|
|
|
|
# |
434
|
|
|
|
|
|
|
### dprint $mailer->as_string; |
435
|
13
|
|
50
|
|
|
48
|
my $method=$config->{'method'} || 'local'; |
436
|
13
|
|
|
|
|
15
|
my $agent=$config->{'agent'}; |
437
|
13
|
50
|
|
|
|
53
|
if(lc($method) eq 'local') { |
438
|
13
|
50
|
|
|
|
29
|
if($agent) { |
439
|
13
|
|
|
|
|
41
|
$mailer->send('sendmail',$agent); |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
else { |
442
|
0
|
|
|
|
|
|
$mailer->send('sendmail'); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
else { |
446
|
0
|
|
0
|
|
|
|
$mailer->send('smtp',$agent || 'localhost'); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
############################################################################### |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub get_to ($%) { |
453
|
0
|
|
|
0
|
0
|
|
return ''; |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
############################################################################### |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub get_from ($%) { |
459
|
0
|
|
|
0
|
0
|
|
return ''; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
############################################################################### |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub get_subject ($%) { |
465
|
0
|
|
|
0
|
0
|
|
return ''; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
############################################################################### |
469
|
|
|
|
|
|
|
1; |
470
|
|
|
|
|
|
|
__END__ |