tcldrop-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Tcldrop/CVS] tcldrop/modules/server server.tcl


From: Philip Moore
Subject: [Tcldrop/CVS] tcldrop/modules/server server.tcl
Date: Mon, 13 Oct 2003 02:28:45 -0400

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/10/13 02:28:45

Modified files:
        modules/server : server.tcl 

Log message:
        Prevent multiple simultaneous server connections by keeping track of the
        timerids.

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

Patches:
Index: tcldrop/modules/server/server.tcl
diff -u tcldrop/modules/server/server.tcl:1.7 
tcldrop/modules/server/server.tcl:1.8
--- tcldrop/modules/server/server.tcl:1.7       Wed Jun  4 17:02:38 2003
+++ tcldrop/modules/server/server.tcl   Mon Oct 13 02:28:45 2003
@@ -1,6 +1,6 @@
 # server.tcl --
 #
-# $Id: server.tcl,v 1.7 2003/06/04 21:02:38 fireegl Exp $
+# $Id: server.tcl,v 1.8 2003/10/13 06:28:45 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -27,7 +27,7 @@
 
 namespace eval ::tcldrop::server {
        variable version {0.2}
-       variable rcsid {$Id: server.tcl,v 1.7 2003/06/04 21:02:38 fireegl Exp $}
+       variable rcsid {$Id: server.tcl,v 1.8 2003/10/13 06:28:45 fireegl Exp $}
        # Provide the server module:
        package provide tcldrop::server $version
        # Initialize variables:
@@ -39,6 +39,8 @@
        # These are aliases for the queues, because we use integers to specify 
queues internally.
        variable QueueAliases
        array set QueueAliases [list quick 10 q 10 mode 15 m 15 server 50 serv 
50 s 50 help 75 h 75]
+       variable TimerID
+       set TimerID 0
        # Export all the commands that should be available to 3rd-party 
scripters:
        namespace export isbotnick jump putserv puthelp putquick queuesize 
clearqueue putqueue putnow server quit
        # Default server related settings (These are here in case the user 
doesn't provide them in his config):
@@ -123,8 +125,9 @@
                        set port ${default-port}
                }
        }
-       set fail 1
        callevent connect-server
+       variable TimerID
+       catch { killutimer $TimerID }
        set fail [catch { connect $serv $port -timeout ${server-timeout} 
-myaddr ${my-ip} -control ::tcldrop::server::Read -errors 
::tcldrop::server::ConnectErrors -writable ::tcldrop::server::Write } idx]
        if {!$fail} {
                ::tcldrop::idx::ChInfo $idx [list handle (server) remote $serv 
hostname $serv port $port type SERVER other serv timestamp [set timestamp 
[unixtime]]]
@@ -133,9 +136,9 @@
                set server-online $timestamp
                set server-idx $idx
                # The timeout here is so that we can try another server.
-               utimer [expr { ${server-timeout} + 1 }] [list 
::tcldrop::server::ConnectTimeout $idx]
+               set TimerID [utimer [expr { ${server-timeout} + 1 }] [list 
::tcldrop::server::ConnectTimeout $idx]]
        } else {
-               utimer ${server-cycle-wait} [list ::tcldrop::server::server]
+               set TimerID [utimer ${server-cycle-wait} [list 
::tcldrop::server::server]]
        }
        return "$serv:$port"
 }




reply via email to

[Prev in Thread] Current Thread [Next in Thread]