Improvements to http code. Increment version for release 0.5

diff --git a/configure b/configure
index 89304333478fc7d93d744f849ec6bc1b2c101c40..d3a4e267cc014f5f4e2888d957d555724f50cdd4 100755 (executable)
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Guess values for system-dependent variables and create Makefiles.
 #! /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
 #
 # 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'
 # 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.
 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
   # 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]...
 
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 


@@ -834,7 +834,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
 
 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
 
    esac
   cat <<\_ACEOF
 


@@ -966,7 +966,7 @@ fi
 test -n "$ac_init_help" && exit 0
 if $ac_init_version; then
   cat <<\_ACEOF
 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.
 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.
 
 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 $@
 generated by GNU Autoconf 2.59.  Invocation command line was
 
   $ $0 $@


@@ -10733,7 +10733,7 @@ _ASBOX
 } >&5
 cat >&5 <<_CSEOF
 
 } >&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
 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="\\
 
 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'`\\"
 
 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 5af798220a8cf82f72b809c2c902a34b68059457..6a9438fa7a7e401bdf02f588213d37c3212d2433 100644 (file)
--- 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.
 #-----------------------------------------------------------------------
 
 # 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.
 
 #--------------------------------------------------------------------
 # Call TEA_INIT as the first TEA_ macro to set up initial vars.

diff --git a/library/http.tcl b/library/http.tcl
index 545b93da2a7934353a3598d9f5d0d5e679756d49..b073c7518b6f7a1af95aef4646f450ee65068be5 100644 (file)
--- 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
     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]]]} {
     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 }
     }
 
     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
         }
     }
             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) 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
     }
     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)
     $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
 }
 
     }
     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
     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
     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
     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 ceb0ea7714f51b1711a25efabc002e4ae7a225f4..a78b7c7113dbc6bd04ff7fde4e76ccb44b22d982 100644 (file)
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -164,7 +164,7 @@ PROJECT = tclole
 #PROJECT_REQUIRES_TK=1
 !include "rules.vc"
 
 #PROJECT_REQUIRES_TK=1
 !include "rules.vc"
 

-DOTVERSION      = 0.4
+DOTVERSION      = 0.5

 VERSION         = $(DOTVERSION:.=)
 STUBPREFIX      = $(PROJECT)stub
 
 VERSION         = $(DOTVERSION:.=)
 STUBPREFIX      = $(PROJECT)stub