? modules/mime/mime.tcl.patch
Index: modules/mime//mime.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/mime/mime.tcl,v
retrieving revision 1.33
diff -u -r1.33 mime.tcl
--- modules/mime//mime.tcl	25 Jun 2003 20:54:59 -0000	1.33
+++ modules/mime//mime.tcl	1 Jul 2003 06:42:54 -0000
@@ -3448,11 +3609,15 @@
 #       charset   The character set to encode the message to.
 #       method    The encoding method (base64 or quoted-printable).
 #       string    The string to encode.
+#       ?-charset_encoded   0 or 1      Whether the data is already encoded
+#                                       in the specified charset (default 1)
+#       ?-maxlength         maxlength   The maximum length of each encoded
+#                                       word to return (default 66)
 #
 # Results:
 #	Returns a word encoded string.
 
-proc ::mime::word_encode {charset method string} {
+proc ::mime::word_encode {charset method string {args}} {
 
     variable encodings
 
@@ -3468,13 +3633,85 @@
 	error "unknown method '$method', must be base64 or quoted-printable"
     }
 
-    set result "=?$encodings($charset)?"
+    # default to encoded and a length that won't make the Subject header to long
+    array set options [list -charset_encoded 1 -maxlength 66]
+    array set options $args
+
+    if { $options(-charset_encoded) } {
+    	set unencoded_string [::encoding convertfrom $charset $string]
+    } else {
+        set unencoded_string $string
+    }
+
+    set string_length [string length $unencoded_string]
+    set string_bytelength [string bytelength $unencoded_string]
+
+    # the 7 is for =?, ?Q?, ?= delimiters of the encoded word
+    set maxlength [expr $options(-maxlength) - \
+        [string length $encodings($charset)] - 7]
+
     switch -exact -- $method {
 	base64 {
-	    append result "B?[string trimright [base64 -mode encode -- $string] \n]?="
+            if { $maxlength < 4 } {
+                error "maxlength $options(-maxlength) too short for chosen\
+                    charset and encoding"
+            }
+            set count 0
+            set maxlength [expr ($maxlength / 4) * 3]
+            while { $count < $string_length } {
+                set length 0
+                set enc_string ""
+                while { ($length < $maxlength) && ($count < $string_length) } {
+                    set char [string range $unencoded_string $count $count]
+                    set enc_char [::encoding convertto $charset $char]
+                    if { ($length + [string length $enc_char]) > $maxlength } {
+                        set length $maxlength
+                    } else {
+                        append enc_string $enc_char
+                        incr count
+                        incr length [string length $enc_char]
+                    }
+                }
+                set encoded_word [base64 -mode encode -- $enc_string]
+                append result "=?$encodings($charset)?B?$encoded_word?=\n "
+            }
+            # Trim off last "\n ", since the above code has the side-effect
+            # of adding an extra "\n " to the encoded string.
+
+            set result [string range $result 0 end-2]
 	}
 	quoted-printable {
-	    append result "Q?[qp_encode $string 1]?="
+            if { $maxlength < 1 } {
+                error "maxlength $options(-maxlength) too short for chosen\
+                    charset and encoding"
+            }
+            set count 0
+            while { $count < $string_length } {
+            set length 0
+            set encoded_word ""
+            while { ($length < $maxlength) && ($count < $string_length) } {
+                set char [string range $unencoded_string $count $count]
+                set enc_char [::encoding convertto $charset $char]
+                set qp_enc_char [qp_encode $enc_char 1]
+                set qp_enc_char_length [string length $qp_enc_char]
+                if { $qp_enc_char_length > $maxlength } {
+                    error "maxlength $options(-maxlength) too short for chosen\
+                        charset and encoding"
+                }
+		if { ($length + [string length $qp_enc_char]) > $maxlength } {
+                    set length $maxlength
+                } else {
+                    append encoded_word $qp_enc_char
+                    incr count
+                    incr length [string length $qp_enc_char]
+                }
+            }
+	    append result "=?$encodings($charset)?Q?$encoded_word?=\n "
+            }
+            # Trim off last "\n ", since the above code has the side-effect
+            # of adding an extra "\n " to the encoded string.
+
+            set result [string range $result 0 end-2]
 	}
 	"" {
 	    # Go ahead
@@ -3546,13 +3783,13 @@
 # ::mime::field_decode --
 #
 #    Word decodes strings that have been word encoded as per RFC 2047
-#    and converts the string from UTF to the original encoding/charset.
+#    and converts the string from the original encoding/charset to UTF.
 #
 # Arguments:
 #       field     The string to decode
 #
 # Results:
-#	Returns the decoded string in its original encoding/charset..
+#	Returns the decoded string in UTF.
 
 proc ::mime::field_decode {field} {
     # ::mime::field_decode is broken.  Here's a new version.
 
Index: modules/mime//mime.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/mime/mime.test,v
retrieving revision 1.9
diff -u -r1.9 mime.test
--- modules/mime//mime.test	25 Jun 2003 20:54:59 -0000	1.9
@@ -226,6 +299,126 @@
 	mime::word_decode "=?ISO-8859-1?b?VGVzdCBsb3dlcmNhc2UgYg==?="
 } {iso8859-1 base64 {Test lowercase b}}
 
+test mime-5.7 {Test word_encode with quoted-printable method across encoded word boundaries} {
+    mime::word_encode iso8859-1 quoted-printable "Test de contrôle effectué" -maxlength 31
+} "=?ISO-8859-1?Q?Test_de_contr?=
+ =?ISO-8859-1?Q?=F4le_effectu?=
+ =?ISO-8859-1?Q?=E9?="
+
+test mime-5.8 {Test word_encode with quoted-printable method across encoded word boundaries} {
+    mime::word_encode iso8859-1 quoted-printable "Test de contrôle effectué" -maxlength 32
+} "=?ISO-8859-1?Q?Test_de_contr?=
+ =?ISO-8859-1?Q?=F4le_effectu?=
+ =?ISO-8859-1?Q?=E9?="
+
+test mime-5.9 {Test word_encode with quoted-printable method and multibyte character} {
+    mime::word_encode euc-jp quoted-printable "Following me is a multibyte character \xA4\xCF"
+} "=?EUC-JP?Q?Following_me_is_a_multibyte_character_=A4=CF?="
+
+set n 10
+while {$n < 14} {
+    test mime-5.$n {Test word_encode with quoted-printable method and multibyte character across encoded word boundary} {
+        mime::word_encode euc-jp quoted-printable "Following me is a multibyte character \xA4\xCF" -maxlength [expr 42 + $n]
+    } "=?EUC-JP?Q?Following_me_is_a_multibyte_character_?=
+ =?EUC-JP?Q?=A4=CF?="
+    incr n
+}
+
+test mime-5.14 {Test word_encode with quoted-printable method and multibyte character (triple)} {
+    mime::word_encode utf-8 quoted-printable "Here is a triple byte encoded character \xE3\x81\xAF"
+} "=?UTF-8?Q?Here_is_a_triple_byte_encoded_character_=E3=81=AF?="
+
+set n 15
+while {$n < 23} {
+    test mime-5.$n {Test word_encode with quoted-printable method and triple byte character across encoded word boundary} {
+        mime::word_encode utf-8 quoted-printable "Here is a triple byte encoded character \xE3\x81\xAF" -maxlength [expr 38 + $n]
+    } "=?UTF-8?Q?Here_is_a_triple_byte_encoded_character_?=
+ =?UTF-8?Q?=E3=81=AF?="
+    incr n
+}
+
+while {$n < 25} {
+    test mime-5.$n {Test word_encode with quoted-printable method and triple byte character across encoded word boundary} {
+        mime::word_encode utf-8 quoted-printable "Here is a triple byte encoded character \xE3\x81\xAF" -maxlength [expr 38 + $n]
+    } "=?UTF-8?Q?Here_is_a_triple_byte_encoded_character_=E3=81=AF?="
+    incr n
+}
+
+while {$n < 29} {
+    test mime-5.$n {Test word_encode with base64 method across encoded word boundaries} {
+        mime::word_encode euc-jp base64 "There is a multibyte character \xA4\xCF" -maxlength [expr 28 + $n]
+    } "=?EUC-JP?B?VGhlcmUgaXMgYSBtdWx0aWJ5dGUgY2hhcmFjdGVy?=
+ =?EUC-JP?B?IKTP?="
+    incr n
+}
+
+while {$n < 33} {
+    test mime-5.$n {Test word_encode with base64 method and triple byte character across encoded word boundary} {
+        mime::word_encode utf-8 base64 "Here is a multibyte character \xE3\x81\xAF" -maxlength [expr 23 + $n]
+    } "=?UTF-8?B?SGVyZSBpcyBhIG11bHRpYnl0ZSBjaGFyYWN0ZXIg?=
+ =?UTF-8?B?44Gv?="
+    incr n
+}
+
+test mime-5.33 {Test word_encode with quoted-printable method and -maxlength set to same length as will the result} {
+    mime::word_encode iso8859-1 quoted-printable "123" -maxlength 20
+} "=?ISO-8859-1?Q?123?="
+
+test mime-5.34 {Test word_encode with base64 method and -maxlength set to same length as will the result} {
+    mime::word_encode iso8859-1 base64 "123" -maxlength 21
+} "=?ISO-8859-1?B?MTIz?="
+
+test mime-5.35 {Test word_encode with quoted-printable method and non charset encoded string} {
+    mime::word_encode utf-8 quoted-printable "\u306F" -charset_encoded 0
+} "=?UTF-8?Q?=E3=81=AF?="
+
+test mime-5.36 {Test word_encode with base64 method and non charset encoded string} {
+    mime::word_encode utf-8 base64 "\u306F" -charset_encoded 0
+} "=?UTF-8?B?44Gv?="
+
+test mime-5.36 {Test word_encode with base64 method and one byte} {
+    mime::word_encode iso8859-1 base64 "a"
+} "=?ISO-8859-1?B?YQ==?="
+
+test mime-5.37 {Test word_encode with base64 method and two bytes} {
+    mime::word_encode euc-jp base64 "\xA4\xCF"
+} "=?EUC-JP?B?pM8=?="
+
+test mime-5.38 {Test word_encode with unknown charset} {
+    catch {mime::word_encode scribble  quoted-printable "scribble is an unknown charset"} errmsg
+    set errmsg
+} "unknown charset 'scribble'"
+
+test mime-5.39 {Test word_encode with invalid charset} {
+    catch {mime::word_encode unicode quoted-printable "unicode is not a valid charset"} errmsg
+    set errmsg
+} "invalid charset 'unicode'"
+
+test mime-5.40 {Test word_encode with invalid method} {
+    catch {mime::word_encode iso8859-1 tea-leaf "tea-leaf is not a valid method"} errmsg
+    set errmsg
+} "unknown method 'tea-leaf', must be base64 or quoted-printable"
+
+test mime-5.41 {Test word_encode with maxlength to short for method quoted-printable} {
+    catch {mime::word_encode iso8859-1 quoted-printable "1" -maxlength 17} errmsg
+    set errmsg
+} "maxlength 17 too short for chosen charset and encoding"
+
+test mime-5.42 {Test word_encode with maxlength to short for method quoted_printable and a charaacter to be quoted} {
+   catch {mime::word_encode iso8859-1 quoted-printable "_" -maxlength 18} errmsg
+   set errmsg
+} "maxlength 18 too short for chosen charset and encoding"
+
+test mime-5.43 {Test word_encode with maxlength to short for method quoted-printable and multibyte character} {
+    catch {mime::word_encode euc-jp quoted-printable "\xA4\xCF" -maxlength 17} errmsg
+    set errmsg
+} "maxlength 17 too short for chosen charset and encoding"
+
+test mime-5.44 {Test word_encode with maxlength to short for method base64} {
+    catch {mime::word_encode iso8859-1 base64 "1" -maxlength 20} errmsg
+    set errmsg
+} "maxlength 20 too short for chosen charset and encoding"
+
 test mime-6.1 {Test field_decode (from RFC 2047, part 8)} {
     mime::field_decode {=?US-ASCII?Q?Keith_Moore?= <moore@cs.utk.edu>}
 } {Keith Moore <moore@cs.utk.edu>}
