Contenido Project

Line #	Revision	Author
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>

Repository List / Contenido / utf8 / core / comps / inc / sendmail.msn @ HEAD

Небольшая справка по веткам