From 25006e4bdeb18024828d1044174345df12958d80 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Thu, 24 Jan 2008 02:32:25 +0000 Subject: [PATCH] Improvements to http code. Increment version for release 0.5 --- configure | 18 +++---- configure.in | 2 +- library/http.tcl | 119 +++++++++++++++++++---------------------------- win/makefile.vc | 2 +- 4 files changed, 59 insertions(+), 82 deletions(-) diff --git a/configure b/configure index 8930433..d3a4e26 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59 for tclole 0.4. +# Generated by GNU Autoconf 2.59 for tclole 0.5. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation @@ -267,8 +267,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='tclole' PACKAGE_TARNAME='tclole' -PACKAGE_VERSION='0.4' -PACKAGE_STRING='tclole 0.4' +PACKAGE_VERSION='0.5' +PACKAGE_STRING='tclole 0.5' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. @@ -777,7 +777,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tclole 0.4 to adapt to many kinds of systems. +\`configure' configures tclole 0.5 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -834,7 +834,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tclole 0.4:";; + short | recursive ) echo "Configuration of tclole 0.5:";; esac cat <<\_ACEOF @@ -966,7 +966,7 @@ fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF -tclole configure 0.4 +tclole configure 0.5 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. @@ -980,7 +980,7 @@ cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tclole $as_me 0.4, which was +It was created by tclole $as_me 0.5, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ @@ -10733,7 +10733,7 @@ _ASBOX } >&5 cat >&5 <<_CSEOF -This file was extended by tclole $as_me 0.4, which was +This file was extended by tclole $as_me 0.5, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -10788,7 +10788,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -tclole config.status 0.4 +tclole config.status 0.5 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" diff --git a/configure.in b/configure.in index 5af7982..6a9438f 100644 --- a/configure.in +++ b/configure.in @@ -19,7 +19,7 @@ dnl to configure the system for the local environment. # so you can encode the package version directly into the source files. #----------------------------------------------------------------------- -AC_INIT([tclole], [0.4]) +AC_INIT([tclole], [0.5]) #-------------------------------------------------------------------- # Call TEA_INIT as the first TEA_ macro to set up initial vars. diff --git a/library/http.tcl b/library/http.tcl index 545b93d..b073c75 100644 --- a/library/http.tcl +++ b/library/http.tcl @@ -22,7 +22,8 @@ proc ::ole::http::geturl {url args} { variable uid ; if {![info exists uid]} { set uid 0 } set token [namespace current]::http[incr uid] upvar #0 $token state - array set state {method GET -query "" -command {} -timeout {} -progress {} -headers {}} + array set state {method GET afterid {} state {} xmlhttp {} + -query "" -command {} -timeout {} -progress {} -headers {}} set state(url) $url while {[string match -* [set option [lindex $args 0]]]} { @@ -42,97 +43,73 @@ proc ::ole::http::geturl {url args} { } if {$state(-query) ne ""} { set state(method) POST } - set state(xmlhttp) "" - foreach progid {MSXML2.XMLHTTP.6.0 MSXML2.XMLHTTP.5.0 MSXML2.XMLHTTP.4.0 \ - MSXML2.XMLHTTP.3.0 MSXML2.XMLHTTP.2.6 Microsoft.XMLHTTP} { - if {![catch {set state(xmlhttp) [ole::ref createobject MSXML2.XMLHTTP]}]} { + foreach progid {MSXML2.XMLHTTP.6.0 MSXML2.XMLHTTP.5.0 \ + MSXML2.XMLHTTP.4.0 MSXML2.XMLHTTP.3.0 \ + MSXML2.XMLHTTP.2.6 Microsoft.XMLHTTP} { + set r [catch {ole::ref createobject $progid} err] + if {!$r} { + set state(xmlhttp) $err break } } - if {$state(xmlhttp) eq {}} { return -code error "error: no suitable XMLHttp object available" } + if {$state(xmlhttp) eq {}} { + return -code error "error: no suitable XMLHttp object available" + } $state(xmlhttp) open $state(method) $url True - $state(xmlhttp) -put onreadystatechange [ole::ref self [list [namespace origin Callback] $token]] + $state(xmlhttp) -put onreadystatechange \ + [ole::ref self [list [namespace origin Callback] $token]] foreach {hdr val} $state(-headers) { $state(xmlhttp) setRequestHeader $hdr $val } + set state(state) waiting + if {$state(-timeout) ne ""} { + set state(afterid) [after $state(-timeout) \ + [list [namespace origin Timeout] $token]] + } $state(xmlhttp) send $state(-query) - if {$state(-command) eq {}} { - wait $token - } else { - watch $token + # this isn't stupid: if the request is already in the IE cache it will + # complete before we hit the next line and if a command was set and + # cleans up the array we will never see it here. + if {[info exists state]} { + if {$state(-command) eq {}} { + if {$state(state) eq "waiting"} { + ::vwait [::set token](state) + } + } } return $token } -proc ::ole::http::Callback {token dispid args} { - # replace the polling stuff with a check of ... +proc ::ole::http::Timeout {token} { upvar #0 $token state - if {[$state(xmlhttp) readyState] == 4} { - # do stuff - } + after cancel $state(afterid) + $state(xmlhttp) abort + Finish $token timeout } -proc ::ole::http::wait {token} { +proc ::ole::http::Callback {token dispid args} { + # replace the polling stuff with a check of ... upvar #0 $token state - watch $token - if {$state(state) eq "waiting"} { - ::vwait [::set token](state) + if {[$state(xmlhttp) readyState] == 4} { + Finish $token ok } } -proc ::ole::http::watch {token} { - variable watchlist - variable watchtimer +proc ::ole::http::Finish {token reason} { upvar #0 $token state - set state(begin) [clock seconds] - set state(state) waiting - after cancel $watchtimer - lappend watchlist $token - Poll -} - -proc ::ole::http::Poll {} { - variable watchlist - variable watchtimer - if {[llength $watchlist] > 0} { - set newlist {} - foreach token $watchlist { - upvar #0 $token state - if {$state(state) eq "waiting"} { - if {[$state(xmlhttp) readyState] == 4} { - set state(state) ok - set state(ncode) [$state(xmlhttp) status] - set state(code) [$state(xmlhttp) statusText] - set state(meta) {} - foreach line [split [$state(xmlhttp) getAllResponseHeaders] "\n"] { - if {[regexp {^([^:]+): ?(.*)} $line -> h v]} { - lappend state(meta) $h [string trimright $v] - } - } - if {$state(-command) ne ""} { - if {[catch {eval $state(-command) $token} err]} { - ::bgerror $err - } - } - break - } - if {$state(-timeout) ne "" - && ([clock seconds] - $state(begin)) > $state(-timeout)} { - set state(state) timeout - $state(xmlhttp) abort - if {$state(-command) ne ""} { - if {[catch {eval $state(-command) $token} err]} { - ::bgerror $err - } - } - break - } - lappend newlist $token - } + after cancel $state(afterid) + set state(ncode) [$state(xmlhttp) status] + set state(code) [$state(xmlhttp) statusText] + set state(meta) {} + foreach line [split [$state(xmlhttp) getAllResponseHeaders] "\n"] { + if {[regexp {^([^:]+): ?(.*)} $line -> h v]} { + lappend state(meta) $h [string trimright $v] } - set watchlist $newlist - if {[llength $watchlist] > 0} { - set watchtimer [after 200 [namespace origin Poll]] + } + set state(state) $reason + if {$state(-command) ne {}} { + if {[catch {eval $state(-command) $token} err]} { + ::bgerror $err } } } diff --git a/win/makefile.vc b/win/makefile.vc index ceb0ea7..a78b7c7 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -164,7 +164,7 @@ PROJECT = tclole #PROJECT_REQUIRES_TK=1 !include "rules.vc" -DOTVERSION = 0.4 +DOTVERSION = 0.5 VERSION = $(DOTVERSION:.=) STUBPREFIX = $(PROJECT)stub -- 2.23.0