diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | doc/http.n | 9 | ||||
| -rw-r--r-- | library/http/http.tcl | 67 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 |
4 files changed, 57 insertions, 27 deletions
@@ -1,3 +1,9 @@ +2008-02-27 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/http/pkgIndex.tcl: Backported 2.5.5 changes from + * library/http/http.tcl: 8.5 version. + * doc/http.n: Document the meta accessor. + 2008-02-26 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOCmd.c (Tcl_GetsObjCmd): do not reuse resultObj as @@ -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.18.2.3 2004/10/27 12:52:40 dkf Exp $ +'\" RCS: @(#) $Id: http.n,v 1.18.2.4 2008/02/27 23:58:17 patthoyts Exp $ '\" .so man.macros .TH "http" n 2.5 http "Tcl Bundled Packages" @@ -35,6 +35,8 @@ http \- Client-side implementation of the HTTP/1.0 protocol. .sp \fB::http::ncode \fItoken\fR .sp +\fB::http::meta \fItoken\fR +.sp \fB::http::data \fItoken\fR .sp \fB::http::error \fItoken\fR @@ -310,6 +312,11 @@ This is a convenience procedure that returns the \fBcurrentsize\fP element of the state array, which represents the number of bytes received from the URL in the \fB::http::geturl\fP call. .TP +\fB::http::meta\fP \fItoken\fP +This is a convenience procedure that returns the \fBmeta\fP +element of the state array which contains the HTTP response +headers. See below for an explanation of this element. +.TP \fB::http::cleanup\fP \fItoken\fP This procedure cleans up the state associated with the connection identified by \fItoken\fP. After this call, the procedures diff --git a/library/http/http.tcl b/library/http/http.tcl index cc91421..1a10b75 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.43.2.14 2008/02/22 11:36:56 patthoyts Exp $ +# RCS: @(#) $Id: http.tcl,v 1.43.2.15 2008/02/27 23:58:18 patthoyts Exp $ # Rough version history: # 1.0 Old http_get interface. @@ -24,7 +24,7 @@ package require Tcl 8.4 # Keep this in sync with pkgIndex.tcl and with the install directories # in Makefiles -package provide http 2.5.4 +package provide http 2.5.5 namespace eval http { variable http @@ -73,7 +73,7 @@ namespace eval http { # http::register -- # -# See documentaion for details. +# See documentation for details. # # Arguments: # proto URL protocol prefix, e.g. https @@ -108,7 +108,7 @@ proc http::unregister {proto} { # http::config -- # -# See documentaion for details. +# See documentation for details. # # Arguments: # args Options parsed by the procedure. @@ -187,7 +187,7 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} { # http::reset -- # -# See documentaion for details. +# See documentation for details. # # Arguments: # token Connection token. @@ -482,19 +482,26 @@ proc http::geturl { url args } { fileevent $s writable [list http::Connect $token] http::wait $token - if {$state(status) eq "error"} { - # Something went wrong while trying to establish the connection. - # 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. - set err [lindex $state(error) 0] - cleanup $token - return -code error $err - } elseif {$state(status) ne "connect"} { - # Likely to be connection timeout + if {![info exists state]} { + # If we timed out then Finish has been called and the users + # command callback may have cleaned up the token. If so + # we end up here with nothing left to do. return $token + } else { + if {$state(status) eq "error"} { + # Something went wrong while trying to establish the connection. + # 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. + set err [lindex $state(error) 0] + cleanup $token + return -code error $err + } elseif {$state(status) ne "connect"} { + # Likely to be connection timeout + return $token + } + set state(status) "" } - set state(status) "" } # Send data in cr-lf format, but accept any line terminators @@ -610,7 +617,7 @@ proc http::geturl { url args } { # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. - if {$state(status) eq "error"} { + if {$state(status) ne "error"} { Finish $token $err 1 } cleanup $token @@ -656,7 +663,11 @@ proc http::size {token} { upvar 0 $token state return $state(currentsize) } - +proc http::meta {token} { + variable $token + upvar 0 $token state + return $state(meta) +} proc http::error {token} { variable $token upvar 0 $token state @@ -787,13 +798,9 @@ proc http::Event {token} { upvar 0 $token state set s $state(sock) - if {[eof $s]} { - Eof $token - return - } if {$state(state) eq "header"} { if {[catch {gets $s line} n]} { - Finish $token $n + return [Finish $token $n] } elseif {$n == 0} { variable encodings set state(state) body @@ -821,6 +828,7 @@ proc http::Event {token} { # Initiate a sequence of background fcopies fileevent $s readable {} CopyStart $s $token + return } } elseif {$n > 0} { if {[regexp -nocase {^content-type:(.+)$} $line x type]} { @@ -855,7 +863,7 @@ proc http::Event {token} { incr state(currentsize) $n } } err]} { - Finish $token $err + return [Finish $token $err] } else { if {[info exists state(-progress)]} { eval $state(-progress) \ @@ -863,6 +871,11 @@ proc http::Event {token} { } } } + + if {[eof $s]} { + Eof $token + return + } } # http::CopyStart @@ -963,7 +976,7 @@ proc http::wait {token} { # http::formatQuery -- # -# See documentaion for details. Call http::formatQuery with an even +# See documentation for details. Call http::formatQuery with an even # number of arguments, where the first is a name, the second is a value, # the third is another name, and so on. # @@ -1038,3 +1051,7 @@ proc http::ProxyRequired {host} { return [list $http(-proxyhost) $http(-proxyport)] } } + +# Local variables: +# indent-tabs-mode: t +# End: diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index eaf0c86..cf6a1ff 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.4]} {return} -package ifneeded http 2.5.4 [list tclPkgSetup $dir http 2.5.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.5.5 [list tclPkgSetup $dir http 2.5.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] |