mime::initializeaux (private)

 mime::initializeaux token [ args... ]

Defined in packages/acs-tcl/tcl/tcllib-doc-procs.tcl

Configure an allocated MIME token's internal state on behalf of mime::initialize. This helper is version-dependent, not a public API.

Parameters:

token (required)

Allocated MIME token to configure.

See Also:

• https://core.tcl-lang.org/tcllib/doc/trunk/embedded/md/tcllib/files/modules/mime/mime.md

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    global errorCode errorInfo
    # FRINK: nocheck
    variable $token
    upvar 0 $token state

    array set params [set state(params) {}]
    set state(encoding) {}
    set state(version) 1.0

    set state(header) {}
    set state(lowerL) {}
    set state(mixedL) {}

    set state(cid) 0

    set argc [llength $args]
    for {set argx 0} {$argx < $argc} {incr argx} {
        set option [lindex $args $argx]
        if {[incr argx] >= $argc} {
            error "missing argument to $option"
        }
        set value [lindex $args $argx]

        switch -- $option {
            -canonical {
                set state(content) [string tolower $value]
            }

            -param {
                if {[llength $value] != 2} {
                    error "-param expects a key and a value, not $value"
                }
                set lower [string tolower [set mixed [lindex $value 0]]]
                if {[info exists params($lower)]} {
                    error "the $mixed parameter may be specified at most once"
                }

                set params($lower) [lindex $value 1]
                set state(params) [array get params]
            }

            -encoding {
                switch -- [set state(encoding) [string tolower $value]] {
                    7bit - 8bit - binary - quoted-printable - base64 {
                    }

                    default {
                        error "unknown value for -encoding $state(encoding)"
                    }
                }
            }

            -header {
                if {[llength $value] != 2} {
                    error "-header expects a key and a value, not $value"
                }
                set lower [string tolower [set mixed [lindex $value 0]]]
                if {$lower eq "content-type"} {
                    error "use -canonical instead of -header $value"
                }
                if {$lower eq "content-transfer-encoding"} {
                    error "use -encoding instead of -header $value"
                }
                if {$lower in {content-md5 mime-version}} {
                    error "don't go there..."
                }
                if {$lower ni $state(lowerL)} {
                    lappend state(lowerL) $lower
                    lappend state(mixedL) $mixed
                }

                array set header $state(header)
                lappend header($lower) [lindex $value 1]
                set state(header) [array get header]
            }

            -file {
                set state(file) $value
            }

            -parts {
                set state(parts) $value
            }

            -string {
                set state(string) $value

                set state(lines) [split $value \n]
                set state(lines.count) [llength $state(lines)]
                set state(lines.current) 0
            }

            -root {
                # the following are internal options

                set state(root) $value
            }

            -offset {
                set state(offset) $value
            }

            -count {
                set state(count) $value
            }

            -lineslist {
                set state(lines) $value
                set state(lines.count) [llength $state(lines)]
                set state(lines.current) 0
                #state(string) is needed, but will be built when required
                set state(string) {}
            }

            default {
                error "unknown option $option"
            }
        }
    }

    #We only want one of -file, -parts or -string:
    set valueN 0
    foreach value {file parts string} {
        if {[info exists state($value)]} {
            set state(value) $value
            incr valueN
        }
    }
    if {$valueN != 1 && ![info exists state(lines)]} {
        error "specify exactly one of -file, -parts, or -string"
    }

    if {[set state(canonicalP) [info exists state(content)]]} {
        switch -- $state(value) {
            file {
                set state(offset) 0
            }

            parts {
                switch -glob -- $state(content) {
                    text/*
                        -
                    image/*
                        -
                    audio/*
                        -
                    video/* {
                        error "-canonical $state(content) and -parts do not mix"
                    }

                    default {
                        if {$state(encoding) ne {}} {
                            error "-encoding and -parts do not mix"
                        }
                    }
                }
            }
            default {# Go ahead}
        }

        if {[lsearch -exact $state(lowerL) content-id] < 0} {
            lappend state(lowerL) content-id
            lappend state(mixedL) Content-ID

            array set header $state(header)
            lappend header(content-id) [uniqueID]
            set state(header) [array get header]
        }

        set state(version) 1.0

        return
    }

    if {$state(params) ne {}} {
        error "-param requires -canonical"
    }
    if {$state(encoding) ne {}} {
        error "-encoding requires -canonical"
    }
    if {$state(header) ne {}} {
        error "-header requires -canonical"
    }
    if {[info exists state(parts)]} {
        error "-parts requires -canonical"
    }

    if {[set fileP [info exists state(file)]]} {
        if {[set openP [info exists state(root)]]} {
            # FRINK: nocheck
            variable $state(root)
            upvar 0 $state(root) root

            set state(fd) $root(fd)
        } else {
            set state(root) $token
            set state(fd) [open $state(file) RDONLY]
            set state(offset) 0
            seek $state(fd) 0 end
            set state(count) [tell $state(fd)]

            fconfigure $state(fd) -translation binary
        }
    }

    set code [catch {mime::parsepart $token} result]
    set ecode $errorCode
    set einfo $errorInfo

    if {$fileP} {
        if {!$openP} {
            unset state(root)
            catch {close $state(fd)}
        }
        unset state(fd)
    }

    return -code $code -errorinfo $einfo -errorcode $ecode $result

XQL Not present:

Generic, PostgreSQL, Oracle