1. #    urlString.tcl --  urlEncode or urlDecode a string
  2. #
  3. #  Description :
  4. #  string Functions
  5. #   urlencode: URL-encodes a string.                (http://www2.tcl.tk/14144)
  6. #   urldecode: URL-decodes a URL-encoded string.    (http://www2.tcl.tk/14144)
  7. #
  8.  
  9.  
  10.  
  11. package provide urlString   1.0
  12. package require Tcl         8.3
  13.  
  14. namespace eval ::urlString:: {
  15.     namespace export urlencode
  16.     namespace export urldecode
  17. }
  18.  
  19.  
  20.  
  21. proc ::urlString::urlencode {string} {
  22.     variable map
  23.     variable alphanumeric a-zA-Z0-9
  24.     for {set i 0} {$i <= 256} {incr i} { 
  25.         set c [format %c $i]
  26.         if {![string match \[$alphanumeric\] $c]} {
  27.             set map($c) %[format %.2x $i]
  28.         }
  29.     }
  30.     # These are handled specially
  31.     array set map { " " + \n %0d%0a }
  32.  
  33.     # The spec says: "non-alphanumeric characters are replaced by '%HH'"
  34.     # 1 leave alphanumerics characters alone
  35.     # 2 Convert every other character to an array lookup
  36.     # 3 Escape constructs that are "special" to the tcl parser
  37.     # 4 "subst" the result, doing all the array substitutions
  38.  
  39.     regsub -all \[^$alphanumeric\] $string {$map(&)} string
  40.     # This quotes cases like $map([) or $map($) => $map(\[) ...
  41.     regsub -all {[][{})\\]\)} $string {\\&} string
  42.     return [subst -nocommand $string]
  43. }
  44.  
  45. proc ::urlString::urldecode {str} {
  46.  
  47.     variable map
  48.     variable alphanumeric a-zA-Z0-9
  49.     for {set i 0} {$i <= 256} {incr i} { 
  50.         set c [format %c $i]
  51.         if {![string match \[$alphanumeric\] $c]} {
  52.             set map($c) %[format %.2x $i]
  53.         }
  54.     }
  55.     # These are handled specially
  56.     array set map { " " + \n %0d%0a }
  57.     # rewrite "+" back to space
  58.     # protect \ from quoting another '\'
  59.     set str [string map [list + { } "\\" "\\\\"] $str]
  60.  
  61.     # prepare to process all %-escapes
  62.     regsub -all -- {%([A-Fa-f0-9][A-Fa-f0-9])} $str {\\u00\1} str
  63.  
  64.     # process \u unicode mapped chars
  65.     return [subst -novar -nocommand $str]
  66. }
  67.  
  68. # ------------------ END OF FILE ------------------