diff options
author | hobbs <hobbs> | 2008-03-12 05:57:43 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2008-03-12 05:57:43 (GMT) |
commit | 2a8fbfca012f397ebc7a5978ce851691cc48ba7b (patch) | |
tree | 81017bbcd52d2c770896c9935385d5f3c5757dd2 /library/http/http.tcl | |
parent | 0a7572c971ff4828a543fd4de8c92affc3d6eaaa (diff) | |
download | tcl-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/http.tcl')
-rw-r--r-- | library/http/http.tcl | 13 |
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" |