Attachment "getbody-decode.patch" to
ticket [763712ffff]
added by
gunzel
2003-07-01 13:58:11.
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
@@ -1274,6 +1404,11 @@
variable $token
upvar 0 $token state
+ if { [set x [lsearch -exact $args -decode]] > -1 } {
+ set decode 1
+ set args [lreplace $args $x $x]
+ }
+
array set options [list -command [list mime::getbodyaux $token] \
-blocksize 4096]
array set options $args
@@ -1418,7 +1553,28 @@
set ecode $errorCode
set einfo $errorInfo
- return -code $code -errorinfo $einfo -errorcode $ecode $result
+ if { $code } {
+ return -code $code -errorinfo $einfo -errorcode $ecode $result
+ }
+
+ if { [info exists decode] } {
+ array set params [mime::getproperty $token params]
+
+ if { [info exists params(charset)] } {
+ set charset $params(charset)
+ } else {
+ set charset US-ASCII
+ }
+
+ set enc [reversemapencoding $charset]
+ if {$enc != ""} {
+ set result [::encoding convertfrom $enc $result]
+ } else {
+ error "-decode failed: can't reversemap charset $charset"
+ }
+ }
+
+ return $result
}
# ::mime::getbodyaux --
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
+++ modules/mime//mime.test 1 Jul 2003 06:42:54 -0000
@@ -174,6 +174,58 @@
set tok [mime::initialize -file badmail2.txt]
} {}
+test mime-3.9 {Parse a MIME message with a charset encoded body and use getbody -decode to get it back} {
+ set msg {MIME-Version: 1.0
+Content-Type: text/plain; charset=ISO-8859-1
+
+Fran\xE7ois
+}
+ set tok [mime::initialize -string $msg]
+ mime::getbody $tok -decode
+} {Fran\xE7ois
+}
+
+test mime-3.10 {Parse a MIME message with a charset encoded body and use getbody -decode to get it back (example from encoding man page)} {
+ set msg {MIME-Version: 1.0
+Content-Type: text/plain; charset=EUC-JP
+Content-Transfer-Encoding: quoted-printable
+
+=A4=CF}
+ set tok [mime::initialize -string $msg]
+ mime::getbody $tok -decode
+} "\u306F"
+
+test mime-3.11 {Parse a MIME message without a charset encoded body and use getbody -decode to get it back} {
+ set msg {MIME-Version: 1.0
+Content-Type: text/plain
+Content-Transfer-Encoding: quoted-printable
+
+A plain text message.}
+ set tok [mime::initialize -string $msg]
+ mime::getbody $tok -decode
+} "A plain text message."
+
+test mime-3.12 {Parse a MIME message with a charset encoded body in an unrecognised charset and use getbody -decode to attempt to get it back} {
+ set msg {MIME-Version: 1.0
+Content-Type: text/plain; charset=SCRIBBLE
+Content-Transfer-Encoding: quoted-printable
+
+This is a message in the scribble charset that tcl does not recognise.}
+ set tok [mime::initialize -string $msg]
+ catch {mime::getbody $tok -decode} errmsg
+ set errmsg
+} "-decode failed: can't reversemap charset SCRIBBLE"
+
+test mime-3.13 {Parse a MIME message with a charset encoded body in an unrecognised charset but don't use -decode so we get it back raw} {
+ set msg {MIME-Version: 1.0
+Content-Type: text/plain; charset=SCRIBBLE
+Content-Transfer-Encoding: quoted-printable
+
+This is a message in the scribble charset that tcl does not recognise.}
+ set tok [mime::initialize -string $msg]
+ mime::getbody $tok
+} "This is a message in the scribble charset that tcl does not recognise."
+
test mime-4.1 {Test qp_encode with a > 76 character string containing special chars.} {
set str1 "foo!\"\t barbaz \$ ` \{ # jack and jill went up a hill to fetch a pail of water. Jack fell down and said !\"\#\$@\[\\\]^`\{\|\}\~ \nJill said, \"Oh my\""
mime::qp_encode $str1
