summaryrefslogtreecommitdiffstats
path: root/library/http/http.tcl
diff options
context:
space:
mode:
authorhobbs <hobbs>2008-03-12 05:39:55 (GMT)
committerhobbs <hobbs>2008-03-12 05:39:55 (GMT)
commit0a7572c971ff4828a543fd4de8c92affc3d6eaaa (patch)
tree54b90ccd98503ae8fe3113a297a0fb6a8b1aaea4 /library/http/http.tcl
parent1d994e8c28b8cb027901f0f1208f9f0f73171f4f (diff)
downloadtcl-0a7572c971ff4828a543fd4de8c92affc3d6eaaa.zip
tcl-0a7572c971ff4828a543fd4de8c92affc3d6eaaa.tar.gz
tcl-0a7572c971ff4828a543fd4de8c92affc3d6eaaa.tar.bz2
* library/http/http.tcl: whitespace changes, code cleanup. Allow
http to be re-sourced without overwriting http state.
Diffstat (limited to 'library/http/http.tcl')
-rw-r--r--library/http/http.tcl99
1 files changed, 50 insertions, 49 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl
index ef7950c..91f2dc9 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.63 2008/02/27 23:49:23 patthoyts Exp $
+# RCS: @(#) $Id: http.tcl,v 1.64 2008/03/12 05:39:58 hobbs Exp $
# Rough version history:
# 1.0 Old http_get interface.
@@ -27,15 +27,19 @@ package require Tcl 8.4
package provide http 2.5.5
namespace eval http {
+ # Allow resourcing to not clobber existing data
+
variable http
- array set http {
- -accept */*
- -proxyhost {}
- -proxyport {}
- -proxyfilter http::ProxyRequired
- -urlencoding utf-8
+ if {![info exists http]} {
+ array set http {
+ -accept */*
+ -proxyhost {}
+ -proxyport {}
+ -proxyfilter http::ProxyRequired
+ -urlencoding utf-8
+ }
+ set http(-useragent) "Tcl http client package [package provide http]"
}
- set http(-useragent) "Tcl http client package [package provide http]"
proc init {} {
# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
@@ -56,8 +60,8 @@ namespace eval http {
init
variable urlTypes
- array set urlTypes {
- http {80 ::socket}
+ if {![info exists urlTypes]} {
+ set urlTypes(http) [list 80 ::socket]
}
variable encodings [string tolower [encoding names]]
@@ -165,23 +169,21 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} {
variable $token
upvar 0 $token state
global errorInfo errorCode
- if {[string length $errormsg] != 0} {
+ if {$errormsg ne ""} {
set state(error) [list $errormsg $errorInfo $errorCode]
- set state(status) error
+ set state(status) "error"
}
catch {close $state(sock)}
- catch {after cancel $state(after)}
+ if {[info exists state(after)]} { after cancel $state(after) }
if {[info exists state(-command)] && !$skipCB} {
if {[catch {eval $state(-command) {$token}} err]} {
- if {[string length $errormsg] == 0} {
+ if {$errormsg eq ""} {
set state(error) [list $err $errorInfo $errorCode]
set state(status) error
}
}
- if {[info exists state(-command)]} {
- # Command callback may already have unset our state
- unset state(-command)
- }
+ # Command callback may already have unset our state
+ unset -nocomplain state(-command)
}
}
@@ -243,12 +245,12 @@ proc http::geturl { url args } {
array set state {
-binary false
- -blocksize 8192
+ -blocksize 8192
-queryblocksize 8192
- -validate 0
- -headers {}
- -timeout 0
- -type application/x-www-form-urlencoded
+ -validate 0
+ -headers {}
+ -timeout 0
+ -type application/x-www-form-urlencoded
-queryprogress {}
state header
meta {}
@@ -257,10 +259,10 @@ proc http::geturl { url args } {
totalsize 0
querylength 0
queryoffset 0
- type text/html
- body {}
+ type text/html
+ body {}
status ""
- http ""
+ http ""
}
# These flags have their types verified [Bug 811170]
array set type {
@@ -367,7 +369,7 @@ proc http::geturl { url args } {
# Note that we don't check the hostname for validity here; if it's
# invalid, we'll simply fail to resolve it later on.
}
- if {$port ne "" && $port>65535} {
+ if {$port ne "" && $port > 65535} {
unset $token
return -code error "Invalid port number: $port"
}
@@ -487,21 +489,19 @@ proc http::geturl { url args } {
# 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) ""
+ } elseif {$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) ""
}
# Send data in cr-lf format, but accept any line terminators
@@ -639,7 +639,7 @@ proc http::data {token} {
return $state(body)
}
proc http::status {token} {
- if {![info exists $token]} { return "error" }
+ if {![info exists $token]} { return "error" }
variable $token
upvar 0 $token state
return $state(status)
@@ -745,8 +745,8 @@ proc http::Write {token} {
# smooth feedback.
puts -nonewline $s \
- [string range $state(-query) $state(queryoffset) \
- [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
+ [string range $state(-query) $state(queryoffset) \
+ [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
incr state(queryoffset) $state(-queryblocksize)
if {$state(queryoffset) >= $state(querylength)} {
set state(queryoffset) $state(querylength)
@@ -778,8 +778,8 @@ proc http::Write {token} {
# Callback to the client after we've completely handled everything.
if {[string length $state(-queryprogress)]} {
- eval $state(-queryprogress) [list $token $state(querylength)\
- $state(queryoffset)]
+ eval $state(-queryprogress) \
+ [list $token $state(querylength) $state(queryoffset)]
}
}
@@ -867,7 +867,7 @@ proc http::Event {token} {
} else {
if {[info exists state(-progress)]} {
eval $state(-progress) \
- {$token $state(totalsize) $state(currentsize)}
+ [list $token $state(totalsize) $state(currentsize)]
}
}
}
@@ -917,7 +917,8 @@ proc http::CopyDone {token count {error {}}} {
set s $state(sock)
incr state(currentsize) $count
if {[info exists state(-progress)]} {
- eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
+ eval $state(-progress) \
+ [list $token $state(totalsize) $state(currentsize)]
}
# At this point the token may have been reset
if {[string length $error]} {
@@ -968,7 +969,7 @@ proc http::wait {token} {
if {![info exists state(status)] || [string length $state(status)] == 0} {
# We must wait on the original variable name, not the upvar alias
- vwait $token\(status)
+ vwait ${token}(status)
}
return [status $token]