[Tcldrop/CVS] tcldrop/modules conn.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/12/02 20:20:16

Modified files:
        modules        : conn.tcl 

Log message:
        Changed conn.tcl to use [gets] instead of [read]..
        There's a bug in [read] that keeps it from sometimes reading whole 
lines, even when -buffering is set to "line".

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/conn.tcl.diff?tr1=1.9&tr2=1.10&r1=text&r2=text

Patches:
Index: tcldrop/modules/conn.tcl
diff -u tcldrop/modules/conn.tcl:1.9 tcldrop/modules/conn.tcl:1.10
--- tcldrop/modules/conn.tcl:1.9        Tue Dec  2 04:01:46 2003
+++ tcldrop/modules/conn.tcl    Tue Dec  2 20:20:16 2003
@@ -3,7 +3,7 @@
 #              * The connect and control commands, used for all outgoing 
connections.
 #      Depends: idx.
 #
-# $Id: conn.tcl,v 1.9 2003/12/02 09:01:46 fireegl Exp $
+# $Id: conn.tcl,v 1.10 2003/12/03 01:20:16 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -32,7 +32,7 @@
 namespace eval ::tcldrop::conn {
        variable version {0.7}
        package provide tcldrop::conn $version
-       variable rcsid {$Id}
+       variable rcsid {$Id: conn.tcl,v 1.10 2003/12/03 01:20:16 fireegl Exp $}
        variable Defaults
        if {![info exists ::my-ip]} { set ::my-ip {} }
        set Defaults(global) [list {async} {1} {buffering} {line} {myaddr} 
${::my-ip} {blocking} {0} {timeout} {237}]
@@ -130,21 +130,22 @@
 proc ::tcldrop::conn::Read {idx} {
        foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d }
        if {![info exists idxinfo(control)]} { return }
-       # For speed, we read in all available lines (This is absolutely 
necessary when running inside an Eggdrop, because Eggdrop's event loops are 1 
second apart.):
-       if {![catch { read -nonewline $idxinfo(sock) } lines]} {
-               foreach line [split $lines \n] {
-                       $idxinfo(control) $idx $line
-                       # The update is here so that one connection can't be 
flooded and drown
-                       # out the other connections and therefore making them 
less responsive.
-                       # At least that's what I hope it's good for.  =)
-                       update
-               }
-       } else {
+       if {[set error [fconfigure $idxinfo(sock) -error]] != {}} {
+               putloglev d * "net: error!(connect) idx $idx  (${error})"
+               # Send {} to the control proc and kill the sock/idx.
+               # Note, A check on valididx (from the control proc) is one way 
to tell wether or not an EOF has actually been received.
+               catch { killutimer $idxinfo(connecttimer) }
+               $idxinfo(control) $idx {}
+               killidx $idx
+       } elseif {[eof $idxinfo(sock)]} {
                putloglev d * "net: eof!(read) idx $idx"
                # Send {} to the control proc and kill the sock/idx.
                # Note, A check on valididx (from the control proc) is one way 
to tell wether or not an EOF has actually been received.
                $idxinfo(control) $idx {}
                killidx $idx
+       } else {
+               # For speed, we read in all available lines (This is absolutely 
necessary when running inside an Eggdrop, because Eggdrop's event loops are 1 
second apart.):
+               while {[gets $idxinfo(sock) line] >= 1} { $idxinfo(control) 
$idx $line }
        }
 }
 
@@ -157,5 +158,8 @@
 
 proc ::tcldrop::conn::ConnectTimeout {idx} {
        putloglev d * "net: timeout!(connect) idx $idx"
+       foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d }
+       catch { killutimer $idxinfo(connecttimer) }
+       catch { fileevent $idxinfo(sock) writable {} }
        killidx $idx
 }