diff options
| author | sandeep <sandeep> | 2000-04-22 07:07:59 (GMT) |
|---|---|---|
| committer | sandeep <sandeep> | 2000-04-22 07:07:59 (GMT) |
| commit | a8e7531672e83d472bbe36d0e63ce316bb0cf562 (patch) | |
| tree | 218bd74182d4e5cb8dcc11bc0c12f69ff4a653a2 /library/http/http.tcl | |
| parent | f4b99eae61b3fd5e5a1a4027365d214a462d6d9b (diff) | |
| download | tcl-a8e7531672e83d472bbe36d0e63ce316bb0cf562.zip tcl-a8e7531672e83d472bbe36d0e63ce316bb0cf562.tar.gz tcl-a8e7531672e83d472bbe36d0e63ce316bb0cf562.tar.bz2 | |
2000-04-21 Sandeep Tamhankar <sandeep@scriptics.com>
* library/http2.1/http.tcl: Fixed a newly introduced bug where if
there's a -command callback and something goes wrong, geturl threw
an exception, called the callback, and unset the token. I changed
it so that it will not call the callback when throwing an
exception (so the caller only finds out about a given error from
one place). Also, fixed http::ncode so that it actually gives you
back the http return code (i.e. 200, 404, etc.) instead of the
first digit of the version of HTTP being used (i.e. 1).
Diffstat (limited to 'library/http/http.tcl')
| -rw-r--r-- | library/http/http.tcl | 28 |
1 files changed, 19 insertions, 9 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index 2137b00..a524415 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.31 2000/04/22 00:37:33 welch Exp $ +# RCS: @(#) $Id: http.tcl,v 1.32 2000/04/22 07:07:59 sandeep Exp $ # Rough version history: # 1.0 Old http_get interface @@ -136,13 +136,17 @@ proc http::config {args} { # Clean up the socket and eval close time callbacks # # Arguments: -# token Connection token. -# errormsg If set, forces status to error. +# token Connection token. +# errormsg (optional) If set, forces status to error. +# skipCB (optional) If set, don't call the -command callback. This +# is useful when geturl wants to throw an exception instead +# of calling the callback. That way, the same error isn't +# reported to two places. # # Side Effects: # Closes the socket - proc http::Finish { token {errormsg ""} } { +proc http::Finish { token {errormsg ""} {skipCB 0}} { variable $token upvar 0 $token state global errorInfo errorCode @@ -152,7 +156,7 @@ proc http::config {args} { } catch {close $state(sock)} catch {after cancel $state(after)} - if {[info exists state(-command)]} { + if {[info exists state(-command)] && !$skipCB} { if {[catch {eval $state(-command) {$token}} err]} { if {[string length $errormsg] == 0} { set state(error) [list $err $errorInfo $errorCode] @@ -327,8 +331,10 @@ proc http::geturl { url args } { if {$conStat} { # something went wrong while trying to establish the connection - - Finish $token + # 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. + Finish $token "" 1 cleanup $token return -code error $s } @@ -448,7 +454,11 @@ proc http::geturl { url args } { # The socket probably was never connected, # or the connection dropped later. - Finish $token $err + # 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. + + Finish $token $err 1 cleanup $token return -code error $err } @@ -480,7 +490,7 @@ proc http::code {token} { proc http::ncode {token} { variable $token upvar 0 $token state - if {[regexp {[0-9]+} $state(http) numeric_code]} { + if {[regexp {[0-9]{3}} $state(http) numeric_code]} { return $numeric_code } else { return $state(http) |