summaryrefslogtreecommitdiffstats
path: root/library/http
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 /library/http
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]
Diffstat (limited to 'library/http')
-rw-r--r--library/http/http.tcl13
1 files changed, 9 insertions, 4 deletions
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"