1 |
36 |
ahitrov@rambler.ru |
<%args> |
2 |
|
|
|
3 |
|
|
$email => undef |
4 |
65 |
ahitrov@rambler.ru |
$etype => 'mixed' |
5 |
36 |
ahitrov@rambler.ru |
|
6 |
|
|
</%args> |
7 |
|
|
<%init> |
8 |
|
|
|
9 |
|
|
return unless ref $email; |
10 |
|
|
|
11 |
|
|
use MIME::Lite; |
12 |
|
|
use MIME::Base64; |
13 |
|
|
|
14 |
|
|
my $subject = $email->{subject}; |
15 |
|
|
$subject = MIME::Base64::encode($subject); |
16 |
73 |
ahitrov@rambler.ru |
$subject =~ s/\s//sgi; |
17 |
36 |
ahitrov@rambler.ru |
$subject = '=?utf-8?B?'.$subject.'?='; |
18 |
|
|
|
19 |
|
|
my $emailfrom; |
20 |
|
|
my ($from, $efrom) = $email->{from} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{from} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{from}); |
21 |
|
|
if ( $from ) { |
22 |
|
|
$from = MIME::Base64::encode($from); |
23 |
|
|
$from =~ s/\s+$//si; |
24 |
|
|
$from = '=?utf-8?B?'.$from.'?='; |
25 |
|
|
$emailfrom = $from.' <'.$efrom.'>'; |
26 |
|
|
} else { |
27 |
|
|
$emailfrom = $efrom; |
28 |
|
|
} |
29 |
|
|
|
30 |
537 |
ahitrov |
my ($emailto, @to); |
31 |
|
|
if ( ref $email->{to} eq 'ARRAY' ) { |
32 |
|
|
foreach my $tostr ( @{$email->{to}} ) { |
33 |
|
|
my ($to, $eto) = $tostr =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $tostr =~ /<(.*?)>/ ? ('',$1) : ('',$tostr); |
34 |
|
|
if ( $to ) { |
35 |
|
|
$to = MIME::Base64::encode($to); |
36 |
|
|
$to =~ s/\s+$//si; |
37 |
|
|
$to = '=?utf-8?B?'.$to.'?='; |
38 |
|
|
push @to, $to.' <'.$eto.'>'; |
39 |
|
|
} else { |
40 |
|
|
push @to, $eto; |
41 |
|
|
} |
42 |
|
|
} |
43 |
|
|
$emailto = shift @to; |
44 |
36 |
ahitrov@rambler.ru |
} else { |
45 |
537 |
ahitrov |
my ($to, $eto) = $email->{to} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{to} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{to}); |
46 |
|
|
if ( $to ) { |
47 |
|
|
$to = MIME::Base64::encode($to); |
48 |
|
|
$to =~ s/\s+$//si; |
49 |
|
|
$to = '=?utf-8?B?'.$to.'?='; |
50 |
|
|
$emailto = $to.' <'.$eto.'>'; |
51 |
|
|
} else { |
52 |
|
|
$emailto = $eto; |
53 |
|
|
} |
54 |
36 |
ahitrov@rambler.ru |
} |
55 |
|
|
my $ccmail; |
56 |
|
|
if ( exists $email->{cc} && ref $email->{cc} eq 'ARRAY' ) { |
57 |
538 |
ahitrov |
foreach my $cc ( @{ $email->{cc}} ) { |
58 |
36 |
ahitrov@rambler.ru |
my ($cce, $ecce) = $cc =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $cc =~ /<(.*?)>/ ? ('',$1) : ('',$cc); |
59 |
|
|
$cc = $ecce; |
60 |
|
|
} |
61 |
537 |
ahitrov |
$ccmail = join ', ', (@to, @{$email->{cc}}); |
62 |
36 |
ahitrov@rambler.ru |
} elsif ( exists $email->{cc} && $email->{cc} ) { |
63 |
|
|
my ($cce, $ecce) = $email->{cc} =~ /^(.*?)<(.*?)>/ ? ($1, $2) : $email->{cc} =~ /<(.*?)>/ ? ('',$1) : ('',$email->{cc}); |
64 |
537 |
ahitrov |
$ccmail = join ', ', (@to, $ecce); |
65 |
539 |
ahitrov |
} elsif ( @to ) { |
66 |
|
|
$ccmail = join ', ', @to; |
67 |
36 |
ahitrov@rambler.ru |
} |
68 |
|
|
|
69 |
|
|
|
70 |
|
|
my $body = $email->{body}; |
71 |
97 |
ahitrov |
warn Dumper($email) if $DEBUG; |
72 |
36 |
ahitrov@rambler.ru |
my $dt = Contenido::DateTime->new; |
73 |
|
|
$dt->set_locale('en_EN'); |
74 |
|
|
my $pdate = $dt->strftime("%a, %d %b %Y %H:%M:%S %z"); |
75 |
|
|
my $msg = MIME::Lite->new( |
76 |
|
|
To => $emailto, |
77 |
|
|
From => $emailfrom, |
78 |
|
|
$ccmail ? ( Cc => $ccmail ) : (), |
79 |
|
|
Subject => $subject, |
80 |
65 |
ahitrov@rambler.ru |
# Encoding=> 'binary', |
81 |
36 |
ahitrov@rambler.ru |
Date => $pdate, |
82 |
213 |
ahitrov |
Type => ($etype eq 'mixed' ? 'multipart/mixed' : $etype eq 'related' ? 'multipart/related;type="multipart/alternative";charset="utf-8"' : $etype), |
83 |
36 |
ahitrov@rambler.ru |
); |
84 |
|
|
$msg->attach( |
85 |
|
|
'Type' => 'text/html;charset="utf-8"', |
86 |
|
|
'Data' => $body, |
87 |
|
|
'Disposition' => '', |
88 |
|
|
); |
89 |
|
|
|
90 |
|
|
$msg->send(); |
91 |
|
|
|
92 |
|
|
</%init> |