Tk Library Source Code

Artifact 28fd53b62d8b19971303890357f4699f1a29ce5c:

Attachment "uri.tcl.diff" to ticket [936064ffff] added by mic42 2004-04-16 10:08:30.

---

Index: uri.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.tcl,v
retrieving revision 1.25
diff -u -b -r1.25 uri.tcl
--- uri.tcl	25 Jan 2004 07:29:51 -0000	1.25
+++ uri.tcl	16 Apr 2004 02:41:17 -0000
@@ -316,7 +316,7 @@
     if {[string match "//*" $url]} {
 	set url [string range $url 2 end]
 
-	array set parts [GetHostPort url]
+    array set parts [GetUPHP url]
     }
 
     set parts(path) [string trimleft $url /]
@@ -334,10 +334,15 @@
 
 proc ::uri::JoinHttpInner {scheme defport args} {
     array set components [list \
-	host {} port $defport path {} query {} \
+    host {} port $defport path {} query {} user {} pwd {} \
     ]
     array set components $args
 
+    set userPwd {}
+    if {[string length $components(user)] || [string length $components(pwd)]} {
+    set userPwd $components(user)[expr {[string length $components(pwd)] ? ":$components(pwd)" : {}}]@
+    }
+    
     set port {}
     if {[string length $components(port)] && $components(port) != $defport} {
 	set port :$components(port)
@@ -356,7 +361,7 @@
 	set components(fragment) ""
     }
 
-    return $scheme://$components(host)$port/$components(path)$components(fragment)$query
+    return $scheme://$userPwd$components(host)$port/$components(path)$components(fragment)$query
 }
 
 proc ::uri::SplitFile {url} {
@@ -770,7 +775,7 @@
 # ------------------------------------------------
 # ftp		//<user>:<password>@<host>:<port>/<cwd1>/.../<cwdN>/<name>;type=<typecode>
 #
-# http		//<host>:<port>/<path>?<searchpart>
+# http      //<user>:<password>@<host>:<port>/<path>?<searchpart>
 #
 # gopher	//<host>:<port>/<gophertype><selector>
 #				<gophertype><selector>%09<search>
@@ -828,8 +833,8 @@
 uri::register http {
     variable	escape \
         [set [namespace parent [namespace current]]::basic::escape]
-    variable	hostOrPort	\
-        [set [namespace parent [namespace current]]::basic::hostOrPort]
+    variable    login   \
+        [set [namespace parent [namespace current]]::basic::login]
 
     variable	charN		{[a-zA-Z0-9$_.+!*'(,);:@&=-]}
     variable	char		"($charN|${escape})"
@@ -838,7 +843,7 @@
     variable	path		"${segment}(/${segment})*"
     variable	search		$segment
     variable	schemepart	\
-	    "//${hostOrPort}(/${path}(\\?${search})?)?"
+        "//${login}(/${path}(\\?${search})?)?"
 
     variable	url		"http:${schemepart}"
 }
@@ -929,4 +934,4 @@
     variable	url		"prospero:$schemepart"
 }
 
-package provide uri 1.1.3
+package provide uri 1.1.4