summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2008-03-12 05:57:43 (GMT)
committerhobbs <hobbs>2008-03-12 05:57:43 (GMT)
commit2a8fbfca012f397ebc7a5978ce851691cc48ba7b (patch)
tree81017bbcd52d2c770896c9935385d5f3c5757dd2
parent0a7572c971ff4828a543fd4de8c92affc3d6eaaa (diff)
downloadtcl-2a8fbfca012f397ebc7a5978ce851691cc48ba7b.zip
tcl-2a8fbfca012f397ebc7a5978ce851691cc48ba7b.tar.gz
tcl-2a8fbfca012f397ebc7a5978ce851691cc48ba7b.tar.bz2
* library/http/http.tcl (http::geturl): add -method option to support
* tests/http.test (http-3.1): http PUT and DELETE requests. * doc/http.n: [Bug 1599901, 862554]
-rw-r--r--ChangeLog4
-rw-r--r--doc/http.n7
-rw-r--r--library/http/http.tcl13
-rw-r--r--tests/http.test4
4 files changed, 21 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 127ec44..dabeb47 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2008-03-11 Jeff Hobbs <jeffh@ActiveState.com>
+ * library/http/http.tcl (http::geturl): add -method option to support
+ * tests/http.test (http-3.1): http PUT and DELETE requests.
+ * doc/http.n: [Bug 1599901, 862554]
+
* library/http/http.tcl: whitespace changes, code cleanup. Allow
http to be re-sourced without overwriting http state.
diff --git a/doc/http.n b/doc/http.n
index d5c8cca..69538f4 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -6,7 +6,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: http.n,v 1.33 2008/03/10 18:49:09 dgp Exp $
+'\" RCS: @(#) $Id: http.n,v 1.34 2008/03/12 05:57:44 hobbs Exp $
'\"
.so man.macros
.TH "http" n 2.5.5 http "Tcl Bundled Packages"
@@ -206,6 +206,11 @@ HTTP request:
Pragma: no-cache
.CE
.TP
+\fB\-method\fR \fItype\fR
+Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
+auto-select GET, POST or HEAD based on other optiosn, but this option
+enables choices like PUT and DELETE for webdav support.
+.TP
\fB\-progress\fR \fIcallback\fR
The \fIcallback\fR is made after each transfer of data from the URL.
The callback gets three additional arguments: the \fItoken\fR from
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 91f2dc9..d508ba0 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: http.tcl,v 1.64 2008/03/12 05:39:58 hobbs Exp $
+# RCS: @(#) $Id: http.tcl,v 1.65 2008/03/12 05:57:44 hobbs Exp $
# Rough version history:
# 1.0 Old http_get interface.
@@ -273,9 +273,11 @@ proc http::geturl { url args } {
-timeout integer
}
set state(charset) $defaultCharset
- set options {-binary -blocksize -channel -command -handler -headers \
- -progress -query -queryblocksize -querychannel -queryprogress\
- -validate -timeout -type}
+ set options {
+ -binary -blocksize -channel -command -handler -headers
+ -method -progress -query -queryblocksize
+ -querychannel -queryprogress -validate -timeout -type
+ }
set usage [join $options ", "]
set options [string map {- ""} $options]
set pat ^-([join $options |])$
@@ -532,6 +534,9 @@ proc http::geturl { url args } {
fconfigure $state(-querychannel) -blocking 1 -translation binary
set contDone 0
}
+ if {[info exists state(-method)] && $state(-method) ne ""} {
+ set how $state(-method)
+ }
if {[catch {
puts $s "$how $srvurl HTTP/1.0"
diff --git a/tests/http.test b/tests/http.test
index c8f82a2..235252e 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
-# RCS: @(#) $Id: http.test,v 1.46 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: http.test,v 1.47 2008/03/12 05:57:44 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -117,7 +117,7 @@ test http-2.1 {http::reset} {
test http-3.1 {http::geturl} {
list [catch {http::geturl -bogus flag} msg] $msg
-} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}}
+} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -method, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}}
test http-3.2 {http::geturl} {
catch {http::geturl http:junk} err
set err