Tk Library Source Code

Artifact [7cf45ff0d5]
Login

Artifact 7cf45ff0d57b826b83869c74a35627c8ba76cc74:

Attachment "ncgi.tcl" to ticket [1948953fff] added by [email protected] 2008-04-22 22:54:20.
proc ::lsflow::cgi::decode {str} {
    set str [string map [list + { } "\\" "\\\\"] $str]
    set i 0
    set result {}
    set illegalEncoding {}
    while {$i < [string length $str]} {
	set ch [string range $str $i $i]
	if {$ch eq "%"} {
	    set substr [string range $str [expr {$i + 1}] [expr {$i + 2}]]
	    if {[scan $substr %2x] < 255} {
		set b1 [scan $substr %2x]
		set b2 [scan [string range $str [expr {$i + 4}] [expr {$i + 5}]] %2x]
		set b3 [scan [string range $str [expr {$i + 7}] [expr {$i + 8}]] %2x]
		set b4 [scan [string range $str [expr {$i + 10}] [expr {$i + 11}]] %2x]

		if {$b1 < 128} {
		    lappend result [format %c $b1]
		    incr i 3
		}

		if {$b1 > 127 && $b1 < 192} {
		    lappend result $substr
		    incr i 3
		}

		if {$b1 > 191 && $b1 < 224} {
		    if {$b2 > 127 && $b2 < 192} {
			lappend result [format %c [expr {(($b1 & 0x1f) << 6) | ($b2 & 0x3f)}]]
		    } else {
			lappend result [string range $str [expr {$i + 4}] [expr {$i + 5}]]
		    }
		    incr i 6
		}

		if {$b1 > 223 && $b1 < 240} {
		    if {$b2 > 127 && $b2 < 192} {
			if {$b3 > 127 && $b3 < 192} {
			    lappend result [format %c [expr {(($b1 & 0xF) << 12) | (($b2 & 0x3F) << 6) | ($b3 & 0x3F)}]]
			} else {
			    lappend result [string range $str [expr {$i + 7}] [expr {$i + 8}]]
			}
		    } else {
			lappend result [string range $str [expr {$i + 7}] [expr {$i + 8}]]
		    }
		    incr i 9
		}

		if {$b1 > 239} {
		    if {$b2 > 127 && $b2 < 192} {
			if {$b3 > 127 && $b3 < 192} {
			    if {$b4 > 127 && $b4 < 192} {
				lappend result [format %c [expr {(($b1 & 0x7) << 18) | (($b2 & 0x3F) << 12) | (($b3 & 0x3F) << 6) | ($b4 & 0x3F)}]]
			    } else {
				lappend result [string range $str [expr {$i + 10}] [expr {$i + 11}]]
			    }
			} else {
			    lappend result [string range $str [expr {$i + 10}] [expr {$i + 11}]]
			}
		    } else {
			lappend result [string range $str [expr {$i + 10}] [expr {$i + 11}]]
		    }
		    incr i 12
		}	  
	    } else {
		lappend result [string range $str [expr {$i + 1}] [expr {$i + 2}]]
		incr i 3
	    }
	} else {
	    lappend result $ch
	    incr i
	}
    }
    join $result ""
}

proc ::lsflow::cgi::encode {str} {
    set unreserved {0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_.~}
    set result {}
    for {set i 0} {$i < [string length $str]} {incr i} {
	set ch [string range $str $i $i]
	set chCode [scan $ch %c]
	if {[string first $ch $unreserved] != -1} {
	    lappend result $ch
	} else {
	    if {$chCode < 128} {
		lappend result [format %%%x $chCode]
	    } 
	    if {$chCode > 127 && $chCode < 2048} {
		lappend result [format %%%x [expr {($chCode >> 6) | 0xC0}]]
		lappend result [format %%%x [expr {($chCode & 0x3F) | 0x80}]]
	    }	    
	    if {$chCode > 2047 && $chCode < 65536} {
		lappend result [format %%%x [expr {($chCode >> 12) | 0xE0}]]
		lappend result [format %%%x [expr {(($chCode >> 6) & 0x3F) | 0x80}]]
		lappend result [format %%%x [expr {($chCode & 0x3F) | 0x80}]]
	    }
	    if {$chCode > 65536} {
		lappend result [format %%%x [expr {($chCode >> 18) | 0xF0}]]
		lappend result [format %%%x [expr {(($chCode >> 12) & 0x3F) | 0x80}]]
		lappend result [format %%%x [expr {(($chCode >> 6) & 0x3F) | 0x80}]]
		lappend result [format %%%x [expr {($chCode & 0x3F) | 0x80}]]
	    }
	}
    }
    join $result ""
}