Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/menuanimations/data/tcl/irk/lib/irkflow.tcl @ 6937

Last change on this file since 6937 was 5781, checked in by rgrieder, 15 years ago

Reverted trunk again. We might want to find a way to delete these revisions again (x3n's changes are still available as diff in the commit mails).

  • Property svn:eol-style set to native
File size: 2.8 KB
Line 
1# irkflow.tcl
2#
3# Simple flow control management so as to avoid flooding.
4
5namespace eval ::irk {
6
7    # For each combination of destination+connection, we keep three items:
8    #
9    # flowctl($dest,$conn,after)        The "after" token for the next time
10    #                                   we send anything to this destination.
11    # flowctl($dest,$conn,queue)        A list of items to send to this
12    #                                   destination on this connection.
13    # flowctl($dest,$conn,lastsend)     The time we last sent to this
14    #                                   destination on this connection.
15    #
16    # NOTE: We do not limit the length of each item to send. This
17    # would lead to extremely hard to diagnose bugs due to commands
18    # (e.g. ctcp's) getting cut up into chunks.
19
20    variable flowctl
21
22    # The following setting controls how often (in msecs) we can send
23    # to a given connection. It should not be modified by user code or
24    # flooding may occur.
25
26    set flowctl(floodlimit) 1500
27
28    # This procedure sends an item to a specific destination+connection.
29    # If possible, the item is sent right away. Otherwise it is enqueued
30    # for later sending.
31
32    proc sendit {conn item} {
33        variable flowctl
34
35        # If this connection has a backlog, append the new
36        # items. Otherwise, check if the previous send was
37        # less than flowctl(floodlimit) msecs ago. If so, enqueue
38        # it for later sending. Otherwise send it now and record
39        # the time we sent this item.
40
41        if {[info exists flowctl($conn,after)]} {
42            lappend flowctl($conn,queue) $item
43        } else {
44            if {[catch {set lastsend $flowctl($conn,lastsend)}]} {
45                set lastsend 0
46            }
47            set now [clock clicks -milliseconds]
48            set lim $flowctl(floodlimit)
49            if {[expr $now - $lastsend] < $lim} {
50                lappend flowctl($conn,queue) $item
51                set wait [expr ($lim - ($now - $lastsend))]
52                set flowctl($conn,after) \
53                        [after $wait [list ::irk::sendlater $conn]]
54            } else {
55                set flowctl($conn,lastsend) $now
56                puts $conn $item
57            }
58        }
59
60        return ""
61    }
62
63    # This procedure does the sending when flow control for a connection
64    # is activated.
65
66    proc sendlater {conn} {
67        variable flowctl
68
69        # First of all clear the after entry.
70
71        unset flowctl($conn,after)
72
73        # Grab the first item on the queue:
74
75        if {[info exists flowctl($conn,queue)]} {
76            set items $flowctl($conn,queue)
77            if {[string compare $items ""]} {
78                set item [lindex $items 0]
79                set rest [lrange $items 1 end]
80                if {[string compare $rest ""]} {
81                    set flowctl($conn,queue) $rest
82                    set flowctl($conn,after) \
83                            [after $flowctl(floodlimit) \
84                                [list ::irk::sendlater $conn]]
85                } else {
86                    unset flowctl($conn,queue)
87                }
88
89                # Record time we last sent to this destination.
90
91                set flowctl($conn,lastsend) [clock clicks -milliseconds]
92
93                # Send this item:
94
95                puts $conn $item
96            } else {
97                unset flowctl($conn,queue)
98            }
99        }
100    }
101}
102
Note: See TracBrowser for help on using the repository browser.