[interchange] UTF-8 enhancements for [email] tag.
Stefan Hornburg
interchange-cvs at icdevgroup.org
Wed May 5 15:33:34 UTC 2010
commit c2cc38eeeb0e747057741796adc840a062a0a255
Author: Rok RužiÄ <rok.ruzic at informa.si>
Date: Wed May 5 17:22:32 2010 +0200
UTF-8 enhancements for [email] tag.
Encode email headers (#255).
Set character set in plain and HTML text parts to UTF-8.
This applies only if MV_UTF8 variable is set.
code/UserTag/email.tag | 79 ++++++++++++++++++++++++++++++++---------------
1 files changed, 54 insertions(+), 25 deletions(-)
---
diff --git a/code/UserTag/email.tag b/code/UserTag/email.tag
index ba20fc7..e71ca14 100644
--- a/code/UserTag/email.tag
+++ b/code/UserTag/email.tag
@@ -21,10 +21,20 @@ BEGIN {
};
}
+sub utf8_to_other {
+ my ($string, $encoding) = @_;
+ return $string unless defined Encode::PERLQQ; # nop if no Encode
+
+ unless(Encode::is_utf8($string)){
+ $string = Encode::decode('utf-8', $string);
+ }
+ return Encode::encode($encoding, $string);
+}
+
sub {
my ($to, $subject, $reply, $from, $extra, $opt, $body) = @_;
my $ok = 0;
- my ($cc, $bcc, @extra);
+ my ($cc, $bcc, @extra, $utf8);
use vars qw/ $Tag /;
@@ -39,6 +49,9 @@ sub {
$cc = $opt->{cc};
$bcc = $opt->{bcc};
+ # See if UTF-8 support is required
+ $utf8 = $::Variable->{MV_UTF8} || $Global::Variable->{MV_UTF8};
+
# Prevent header injections from spammers' hostile content
for ($to, $subject, $reply, $from, $cc, $bcc) {
# unfold valid RFC 2822 "2.2.3. Long Header Fields"
@@ -58,6 +71,13 @@ sub {
}
unshift @extra, "From: $from" if $from;
+ # force utf8 email through MIME as attachment
+ unless (($opt->{attach} || $opt->{html}) && $utf8){
+ $opt->{attach} = [()];
+ $opt->{body_mime} = $opt->{mimetype};
+ $body = utf8_to_other($body, 'utf-8');
+ }
+
my $sent_with_attach = 0;
ATTACH: {
@@ -82,14 +102,13 @@ sub {
my @attach;
my @extra_headers;
- for(@extra) {
- m{(.*?):\s+(.*)};
- my $name = $1 or next;
- next if lc($name) eq 'from';
- my $content = $2 or next;
- $name =~ s/[-_]+/-/g;
- $name =~ s/\b(\w)/\U$1/g;
- push @extra_headers, "$name:", $content;
+ # encode values if utf8 is supported
+ if($utf8){
+ $to = utf8_to_other($to, 'MIME-Header');
+ $from = utf8_to_other($from, 'MIME-Header');
+ $subject = utf8_to_other($subject, 'MIME-Header');
+ $cc = utf8_to_other($cc, 'MIME-Header');
+ $bcc = utf8_to_other($bcc, 'MIME-Header');
}
my $msg = new MIME::Lite
@@ -99,10 +118,22 @@ sub {
Type => $opt->{mimetype},
Cc => $cc,
Bcc => $bcc,
- @extra_headers,
;
- $opt->{body_mime} ||= 'text/plain';
- $opt->{body_encoding} ||= '8bit';
+
+ for(@extra) {
+ m{(.*?):\s+(.*)};
+ my $name = $1 or next;
+ next if lc($name) eq 'from';
+ my $content = $2 or next;
+ $name =~ s/[-_]+/-/g;
+ $name =~ s/\b(\w)/\U$1/g;
+ $msg->add($name, ($utf8 ? utf8_to_other($content, 'UTF-8')
+ : $content))
+ if $name && $content;
+ }
+
+ $opt->{body_mime} ||= 'text/plain' . ($utf8 ? '; charset=UTF-8' : '');
+ $opt->{body_encoding} ||= 'quoted-printable';
$msg->attach(
Type => $opt->{body_mime},
Encoding => $opt->{body_encoding},
@@ -122,15 +153,15 @@ sub {
$att ||= [];
if($opt->{html}) {
- unshift @$att, {
- type => 'text/html',
- data => $opt->{html},
- disposition => 'inline',
+ unshift @$att, {type => 'text/html'
+ .($utf8 ? '; charset=UTF-8': ''),
+ data => $opt->{html},
+ disposition => 'inline',
};
}
my %encoding_types = (
- 'text/plain' => '8bit',
+ 'text/plain' => ($utf8 ? 'quoted-printable' : '8bit'),
'text/html' => 'quoted-printable',
);
@@ -165,17 +196,15 @@ sub {
}
}
- my $body = $msg->as_string;
-#::logDebug("Mail body: \n$body");
+ my $body = $msg->body_as_string;
+ my $header = $msg->header_as_string;
+#::logDebug("[email] Mail: \n$header\n$body");
if($opt->{test}) {
- return $body;
+ return "$header\n$body";
}
else {
- $body =~ s/^(.+?)(?:\r?\n){2}//s;
- my $headers = $1;
- last SEND unless $headers;
- my @head = split(/\r?\n/,$headers);
-
+ last ATTACH unless $header;
+ my @head = split(/\r?\n/,$header);
$ok = send_mail(\@head,$body);
$sent_with_attach = 1;
More information about the interchange-cvs
mailing list