[Rt-commit] r5822 - in rt/branches/3.4-RELEASE/lib: t/regression

[ruz at bestpractical.com]

Author: ruz
Date: Tue Aug 29 15:10:01 2006
New Revision: 5822

Added:
   rt/branches/3.4-RELEASE/lib/t/regression/06-mime_decoding.t
Modified:
   rt/branches/3.4-RELEASE/lib/RT/I18N.pm

Log:
* fix decoding of the MIME fields, this should fix:
** problems with non-ascii names of attachments
** problems with partly encoded fields with '=' chars
   in not encoded parts, for example:

X-MyHeader: key="plain"; key="=?encoded?="
X-MyHeader: key="=?encoded?="; key="plain"


Modified: rt/branches/3.4-RELEASE/lib/RT/I18N.pm
==============================================================================
--- rt/branches/3.4-RELEASE/lib/RT/I18N.pm	(original)
+++ rt/branches/3.4-RELEASE/lib/RT/I18N.pm	Tue Aug 29 15:10:01 2006
@@ -289,11 +289,13 @@
     my $str = shift;
     my $enc = shift;
 
-   
-    @_ = $str =~ m/([^=]*)=\?([^?]+)\?([QqBb])\?([^?]+)\?=([^=]*)/g;
-
+    @_ = $str =~ m/(.*?)=\?([^?]+)\?([QqBb])\?([^?]+)\?=([^=]*)/gc;
     return ($str) unless (@_);
 
+    # add everything that hasn't matched to the end of the latest
+    # string in array this happen when we have 'key="=?encoded?="; key="plain"'
+    @_[-1] .= substr($str, pos $str);
+
     $str = "";
     while (@_) {
 	my ($prefix, $charset, $encoding, $enc_str, $trailing) =

Added: rt/branches/3.4-RELEASE/lib/t/regression/06-mime_decoding.t
==============================================================================
--- (empty file)
+++ rt/branches/3.4-RELEASE/lib/t/regression/06-mime_decoding.t	Tue Aug 29 15:10:01 2006
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+use_ok("RT");
+
+RT::LoadConfig();
+RT::Init();
+
+use_ok('RT::I18N');
+
+diag q{'=' char in a leading part before an encoded part} if $ENV{TEST_VERBOSE};
+{
+    my $str = 'key="plain"; key="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="';
+    is(
+        RT::I18N::DecodeMIMEWordsToUTF8($str),
+        'key="plain"; key="мой_файл.bin"',
+        "right decoding"
+    );
+}
+
+diag q{not compliant with standards, but MUAs send such field when attachment has non-ascii in name}
+    if $ENV{TEST_VERBOSE};
+{
+    my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="';
+    is(
+        RT::I18N::DecodeMIMEWordsToUTF8($str),
+        'attachment; filename="мой_файл.bin"',
+        "right decoding"
+    );
+}
+
+diag q{'=' char in a trailing part after an encoded part} if $ENV{TEST_VERBOSE};
+{
+    my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="; some_prop="value"';
+    is(
+        RT::I18N::DecodeMIMEWordsToUTF8($str),
+        'attachment; filename="мой_файл.bin"; some_prop="value"',
+        "right decoding"
+    );
+}
+