* 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]

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"