Attachment "latest.diff" to
ticket [636977ffff]
added by
davidw
2002-11-12 13:49:17.
? latest.diff
Index: uri.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.man,v
retrieving revision 1.2
diff -u -r1.2 uri.man
--- uri.man 26 Mar 2002 07:40:36 -0000 1.2
+++ uri.man 12 Nov 2002 06:45:09 -0000
@@ -23,10 +23,9 @@
the constituents of the [arg url]. If the scheme is missing from the
url it defaults to [strong http]. Currently only the schemes
-[strong http], [strong ftp], [strong mailto], [strong urn] and
-
-[strong file] are supported. See section [strong EXTENDING] on how to
-expand that range.
+[strong http], [strong ftp], [strong mailto], [strong urn], [strong news],
+and [strong file] are supported. See section [strong EXTENDING]
+on how to expand that range.
[call [cmd uri::join] [opt "[arg key] [arg value]"]...]
@@ -35,8 +34,8 @@
[cmd uri::split], for example) and returns the canonical url they
represent. Currently only the schemes [strong http], [strong ftp],
-[strong mailto], [strong urn] and [strong file] are supported. See
-section [strong EXTENDING] on how to expand that range.
+[strong mailto], [strong urn], [strong news], and [strong file] are
+supported. See section [strong EXTENDING] on how to expand that range.
[call [cmd uri::resolve] [arg base] [arg url]]
@@ -143,5 +142,4 @@
Original code by Andreas Kupries.
Modularisation by Steve Ball.
-[keywords uri url {fetching information} www http ftp mailto gopher wais prospero file]
-[manpage_end]
+[keywords uri url {fetching information} www http ftp mailto news gopher wais prospero file] [manpage_end]
Index: uri.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.tcl,v
retrieving revision 1.15
diff -u -r1.15 uri.tcl
--- uri.tcl 26 Feb 2002 04:59:44 -0000 1.15
+++ uri.tcl 12 Nov 2002 06:45:10 -0000
@@ -22,7 +22,7 @@
namespace export register
variable file:counter 0
-
+
# extend these variable in the coming namespaces
variable schemes {}
variable schemePattern ""
@@ -47,11 +47,11 @@
variable hex {[0-9A-Fa-f]}
variable alphaDigit {[A-Za-z0-9]}
variable alphaDigitMinus {[A-Za-z0-9-]}
-
+
# next is <national | punctuation>
variable unsafe {[][<>"#%\{\}|\\^~`]} ;#" emacs hilit
variable escape "%${hex}${hex}"
-
+
# unreserved = alpha | digit | safe | extra
# xchar = unreserved | reserved | escape
@@ -254,7 +254,7 @@
if {[string length $components(type)]} {
set type \;type=$components(type)
}
-
+
return ftp://${userPwd}$components(host)${port}/[string trimleft $components(path) /]$type
}
@@ -435,6 +435,22 @@
return mailto:$components(user)@$components(host)
}
+proc uri::SplitNews {url} {
+ if { [string first @ $url] >= 0 } {
+ return [list message-id $url]
+ } else {
+ return [list newsgroup-name $url]
+ }
+}
+
+proc uri::JoinNews args {
+ array set components {
+ message-id {} newsgroup-name {}
+ }
+ array set components $args
+ return news:$components(message-id)$components(newsgroup-name)
+}
+
proc uri::GetUPHP {urlvar} {
# @c Parse user, password host and port out of the url stored in
# @c variable <a urlvar>.
@@ -462,7 +478,7 @@
if {[regexp -indices -- $upPattern $url match theUser c d thePassword]} {
set fu [lindex $theUser 0]
set tu [lindex $theUser 1]
-
+
set fp [lindex $thePassword 0]
set tp [lindex $thePassword 1]
@@ -775,7 +791,7 @@
uri::register ftp {
set escape [set [namespace parent [namespace current]]::basic::escape]
set login [set [namespace parent [namespace current]]::basic::login]
-
+
variable charN {[a-zA-Z0-9$_.+!*'(,)?:@&=-]}
variable char "(${charN}|${escape})"
variable segment "${char}*"
@@ -828,7 +844,7 @@
"//${hostOrPort}(/(${type}(${selector}(%09${search}(%09${string})?)?)?)?)?"
variable url "gopher:${schemepart}"
}
-
+
# MAILTO
uri::register mailto {
set xChar [set [namespace parent [namespace current]]::basic::xChar]
Index: uri.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.test,v
retrieving revision 1.11
diff -u -r1.11 uri.test
--- uri.test 5 Jun 2002 22:59:07 -0000 1.11
+++ uri.test 12 Nov 2002 06:45:10 -0000
@@ -62,6 +62,15 @@
eval kvsort [uri::split {ftp://localhost:21/a/b/c.d}]
} {host localhost path a/b/c.d port 21 pwd {} scheme ftp type {} user {}}
+test uri-1.9 {uri::split - news with message-id} {
+ eval kvsort [uri::split {news:[email protected]}]
+} {message-id [email protected] scheme news}
+
+test uri-1.10 {uri::split - news with newsgroup-name} {
+ eval kvsort [uri::split {news:comp.lang.tcl}]
+} {newsgroup-name comp.lang.tcl scheme news}
+
+
# -------------------------------------------------------------------------
test uri-2.1 {uri::join - http} {
@@ -122,6 +131,15 @@
test uri-2.14 {uri::join - ftp w/- invalid type} {
eval uri::join scheme ftp host localhost path a/b/c.d type X
} {ftp://localhost/a/b/c.d;type=X}
+
+test uri-2.15 {uri::join - news message-id} {
+ eval uri::join scheme news message-id [email protected]
+} {news:[email protected]}
+
+test uri-2.16 {uri::join - news newsgroup-name} {
+ eval uri::join scheme news newsgroup-name comp.lang.tcl
+} {news:comp.lang.tcl}
+
# -------------------------------------------------------------------------
