Tk Library Source Code

Artifact a67fb25eb1484aab381a25c184706ede31555a36:

Attachment "parseMimeValue.tcl" to ticket [2907556fff] added by fridolin 2009-12-02 22:51:53.

---

# ::ncgi::parseMimeValue
#
#	Parse a MIME header value, which has the form
#	value; param=value; param2="value2"; param3='value3'
#
# Arguments:
#	value	The mime header value.  This does not include the mime
#		header field name, but everything after it.
#
# Results:
#	A two-element list, the first is the primary value,
#	the second is in turn a name-value list corresponding to the
#	parameters.  Given the above example, the return value is
#	{
#		value
#		{param value param2 value param3 value3}
#	}

proc ::ncgi::parseMimeValue {value} {
    regexp {^[^;]*} $value part0 ;# matches at least the empty string => part0 is defined
    set results [list [string trim $part0]]
    set paramList [list]
    set params [regexp -inline -all -start [string length $part0] \
                             {;([^=]+)=("[^"]*"|'[^']*'|[^;]*)} $value]
    foreach {_ key val} $params {
        set key [string trim [string tolower $key]]
        set val [string trim $val]
        # Allow single as well as double quotes
        if {[regexp -- {^["']} $val quote]} { ;# need a " for balance
            if {[regexp -- ^${quote}(\[^$quote\]*)$quote $val x val2]} {
                # Trim quotes and any extra crap after close quote
                set val $val2
             }
         }
         lappend paramList $key $val
    }
    if {[llength $paramList]} {
	lappend results $paramList
    }
    return $results
}