Defined in
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
-
No testcase defined.
Source code:
global errorCode errorInfo
variable $token
upvar 0 $token state
set decode 0
if {[set pos [lsearch -exact $args -decode]] >= 0} {
set decode 1
set args [lreplace $args $pos $pos]
}
array set options [list -command [
list mime::getbodyaux $token] -blocksize 4096]
array set options $args
if {$options(-blocksize) < 1} {
error "-blocksize expects a positive integer, not $options(-blocksize)"
}
set code 0
set ecode {}
set einfo {}
switch -- $state(value)/$state(canonicalP) {
file/0 {
set fd [open $state(file) RDONLY]
set code [catch {
fconfigure $fd -translation binary
seek $fd [set pos $state(offset)] start
set last [expr {$state(offset) + $state(count) - 1}]
set fragment {}
while {$pos <= $last} {
if {[set cc [
expr {($last - $pos) + 1}]] > $options(-blocksize)} {
set cc $options(-blocksize)
}
incr pos [set len [
string length [set chunk [read $fd $cc]]]]
switch -exact -- $state(encoding) {
base64
-
quoted-printable {
if {([set x [string last \n $chunk]] > 0) && ($x + 1 != $len)} {
set chunk [string range $chunk 0 $x]
seek $fd [incr pos [expr {($x + 1) - $len}]] start
}
set chunk [
$state(encoding) -mode decode -- $chunk]
}
7bit - 8bit - binary - {} {
}
default {
error "Can't handle content encoding \"$state(encoding)\""
}
}
append fragment $chunk
set cc [expr {$options(-blocksize) - 1}]
while {[string length $fragment] > $options(-blocksize)} {
uplevel #0 $options(-command) [
list data [string range $fragment 0 $cc]]
set fragment [
string range $fragment $options(-blocksize) end]
}
}
if {[string length $fragment] > 0} {
uplevel #0 $options(-command) [list data $fragment]
}
} result]
set ecode $errorCode
set einfo $errorInfo
catch {close $fd}
}
file/1 {
set fd [open $state(file) RDONLY]
set code [catch {
fconfigure $fd -translation binary
while {[string length [
set fragment [read $fd $options(-blocksize)]]] > 0} {
uplevel #0 $options(-command) [list data $fragment]
}
} result]
set ecode $errorCode
set einfo $errorInfo
catch {close $fd}
}
parts/0
-
parts/1 {
error "MIME part isn't a leaf"
}
string/0
-
string/1 {
switch -- $state(encoding)/$state(canonicalP) {
base64/0
-
quoted-printable/0 {
set fragment [
$state(encoding) -mode decode -- $state(string)]
}
default {
set fragment $state(string)
}
}
set code [catch {
set cc [expr {$options(-blocksize) -1}]
while {[string length $fragment] > $options(-blocksize)} {
uplevel #0 $options(-command) [
list data [string range $fragment 0 $cc]]
set fragment [
string range $fragment $options(-blocksize) end]
}
if {[string length $fragment] > 0} {
uplevel #0 $options(-command) [list data $fragment]
}
} result]
set ecode $errorCode
set einfo $errorInfo
}
default {
error "Unknown combination \"$state(value)/$state(canonicalP)\""
}
}
set code [catch {
if {$code} {
uplevel #0 $options(-command) [list error $result]
} else {
uplevel #0 $options(-command) [list end]
}
} result]
set ecode $errorCode
set einfo $errorInfo
if {$code} {
return -code $code -errorinfo $einfo -errorcode $ecode $result
}
if {$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 ne {}} {
set result [::encoding convertfrom $enc $result]
} else {
return -code error "-decode failed: can't reversemap charset $charset"
}
}
return $result
XQL Not present:Generic, PostgreSQL, Oracle
