diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/http/http.tcl | 23 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 |
2 files changed, 13 insertions, 12 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index d0cf058..ae2b1d4 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -9,7 +9,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.43.2.3 2003/10/02 23:07:33 dgp Exp $ +# RCS: @(#) $Id: http.tcl,v 1.43.2.4 2004/05/25 22:50:47 hobbs Exp $ # Rough version history: # 1.0 Old http_get interface @@ -25,7 +25,7 @@ package require Tcl 8.2 # keep this in sync with pkgIndex.tcl # and with the install directories in Makefiles -package provide http 2.4.5 +package provide http 2.5.0 namespace eval http { variable http @@ -34,6 +34,7 @@ namespace eval http { -proxyhost {} -proxyport {} -proxyfilter http::ProxyRequired + -urlencoding utf-8 } set http(-useragent) "Tcl http client package [package provide http]" @@ -262,7 +263,7 @@ proc http::geturl { url args } { -queryblocksize integer -validate boolean -timeout integer - } + } set state(charset) $defaultCharset set options {-binary -blocksize -channel -command -handler -headers \ -progress -query -queryblocksize -querychannel -queryprogress\ @@ -460,7 +461,7 @@ proc http::geturl { url args } { # (among Solaris, Linux, and NT) behave the same, and none # behave all that well in any case. Servers should always read thier # POST data if they expect the client to read their response. - + if {$isQuery || $isQueryChannel} { puts $s "Content-Type: $state(-type)" if {!$contDone} { @@ -485,7 +486,7 @@ proc http::geturl { url args } { # Something went wrong, so throw the exception, and the # enclosing catch will do cleanup. return -code error [lindex $state(error) 0] - } + } } } err]} { # The socket probably was never connected, @@ -494,7 +495,7 @@ proc http::geturl { url args } { # Clean up after events and such, but DON'T call the command callback # (if available) because we're going to throw an exception from here # instead. - + # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. if {[string equal $state(status) "error"]} { @@ -609,16 +610,13 @@ proc http::Write {token} { variable $token upvar 0 $token state set s $state(sock) - + # Output a block. Tcl will buffer this if the socket blocks - set done 0 if {[catch { - # Catch I/O errors on dead sockets if {[info exists state(-query)]} { - # Chop up large query strings so queryprogress callback # can give smooth feedback @@ -631,7 +629,6 @@ proc http::Write {token} { set done 1 } } else { - # Copy blocks from the query channel set outStr [read $state(-querychannel) $state(-queryblocksize)] @@ -889,6 +886,7 @@ proc http::formatQuery {args} { # The encoded string proc http::mapReply {string} { + variable http variable formMap variable alphanumeric @@ -898,6 +896,9 @@ proc http::mapReply {string} { # 3 Escape constructs that are "special" to the tcl parser # 4 "subst" the result, doing all the array substitutions + if {$http(-urlencoding) ne ""} { + set string [encoding convertto $http(-urlencoding) $string] + } regsub -all \[^$alphanumeric\] $string {$formMap(&)} string regsub -all {[][{})\\]\)} $string {\\&} string return [subst -nocommand $string] diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index e114a44..8efa64c 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded http 2.4.5 [list tclPkgSetup $dir http 2.4.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] +package ifneeded http 2.5.0 [list tclPkgSetup $dir http 2.5.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] |