home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / uri / urn-scheme.tcl < prev   
Encoding:
Text File  |  2004-02-15  |  3.3 KB  |  110 lines
  1. # urn-scheme.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com>
  2. #
  3. # extend the uri package to deal with URN (RFC 2141)
  4. # see http://www.normos.org/ietf/rfc/rfc2141.txt
  5. #
  6. # Released under the tcllib license.
  7. #
  8. # $Id: s.urn-scheme.tcl 1.6 03/04/29 00:46:18-00:00 patthoyts $
  9. # -------------------------------------------------------------------------
  10.  
  11. package provide uri::urn 1.0.1
  12. package require uri      1.1.2
  13.  
  14. namespace eval ::uri {}
  15. namespace eval ::uri::urn {}
  16.  
  17. ::uri::register {urn URN} {
  18.     variable NIDpart {[a-zA-Z0-9][a-zA-Z0-9-]{0,31}}
  19.         variable esc {%[0-9a-fA-F]{2}}
  20.         variable trans {a-zA-Z0-9$_.+!*'(,):=@;-}
  21.         variable NSSpart "($esc|\[$trans\])+"
  22.         variable URNpart "($NIDpart):($NSSpart)"
  23.         variable schemepart $URNpart
  24.     variable url "urn:$NIDpart:$NSSpart"
  25. }
  26.  
  27. # -------------------------------------------------------------------------
  28.  
  29. # Description:
  30. #   Called by uri::split with a url to split into its parts.
  31. #
  32. proc ::uri::SplitUrn {uri} {
  33.     #@c Split the given uri into then URN component parts
  34.     #@a uri: the URI to split without it's scheme part.
  35.     #@r List of the component parts suitable for 'array set'
  36.  
  37.     upvar \#0 [namespace current]::urn::URNpart pattern
  38.     array set parts {nid {} nss {}}
  39.     if {[regexp -- ^$pattern $uri -> parts(nid) parts(nss)]} {
  40.         return [array get parts]
  41.     } else {
  42.         error "invalid urn syntax: \"$uri\" could not be parsed"
  43.     }
  44. }
  45.  
  46.  
  47. # -------------------------------------------------------------------------
  48.  
  49. proc ::uri::JoinUrn args {
  50.     #@c Join the parts of a URN scheme URI
  51.     #@a list of nid value nss value
  52.     #@r a valid string representation for your URI
  53.     variable urn::NIDpart
  54.  
  55.     array set parts [list nid {} nss {}]
  56.     array set parts $args
  57.     if {! [regexp -- ^$NIDpart$ $parts(nid)]} {
  58.         error "invalid urn: nid is invalid"
  59.     }
  60.     set url "urn:$parts(nid):[urn::quote $parts(nss)]"
  61.     return $url
  62. }
  63.  
  64. # -------------------------------------------------------------------------
  65.  
  66. # Quote the disallowed characters according to the RFC for URN scheme.
  67. # ref: RFC2141 sec2.2
  68. proc ::uri::urn::quote {url} {
  69.     variable trans
  70.     
  71.     set ndx 0
  72.     set result ""
  73.     while {[regexp -indices -- "\[^$trans\]" $url r]} {
  74.         set ndx [lindex $r 0]
  75.         scan [string index $url $ndx] %c chr
  76.         set rep %[format %.2X $chr]
  77.         if {[string match $rep %00]} {
  78.             error "invalid character: character $chr is not allowed"
  79.         }
  80.         
  81.         incr ndx -1
  82.         append result [string range $url 0 $ndx] $rep
  83.         incr ndx 2
  84.         set url [string range $url $ndx end]
  85.     }
  86.     append result $url
  87.     return $result
  88. }
  89.  
  90. # -------------------------------------------------------------------------
  91.  
  92. # Perform the reverse of urn::quote.
  93. proc ::uri::urn::unquote {url} {
  94.     set ndx 0
  95.     while {[regexp -start $ndx -indices {%([0-9a-zA-Z]{2})} $url r]} {
  96.         set first [lindex $r 0]
  97.         set last [lindex $r 1]
  98.         set str [string replace [string range $url $first $last] 0 0 0x]
  99.         set c [format %c $str]
  100.         set url [string replace $url $first $last $c]
  101.         set ndx [expr {$last + 1}]
  102.     }
  103.     return $url
  104. }
  105.  
  106. # -------------------------------------------------------------------------
  107. # Local Variables:
  108. #   indent-tabs-mode: nil
  109. # End:
  110.