diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | doc/http.n | 7 | ||||
| -rw-r--r-- | library/http/http.tcl | 13 | ||||
| -rw-r--r-- | tests/http.test | 4 |
4 files changed, 21 insertions, 7 deletions
@@ -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. @@ -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 |