Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/trunk/data/tcl/irk/lib/irkqueue.tcl @ 7512

Last change on this file since 7512 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.9 KB
Line 
1# irkenqueue.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 determines the number of seconds that must
23    # pass between sends to any one destination+connection. If fewer
24    # seconds have passed since the last send, then flow control is
25    # activated for this destination+connection.
26
27    set flowctl(sendlimit) 2
28
29    # This procedure sends an item to a specific destination+connection.
30    # If possible, the item is sent right away. Otherwise it is enqueued
31    # for later sending.
32
33    proc enqueue {dest conn item} {
34        variable flowctl
35
36        # If this destination has a backlog, append the new
37        # items. Otherwise, check if the previous send was
38        # less than 2 seconds ago. If so, enqueue it for
39        # later sending. Otherwise send it now and record
40        # the time we sent this item.
41
42        if {[info exists flowctl($dest,$conn,after)]} {
43            lappend flowctl($dest,$conn,queue) $item
44        } else {
45            if {[catch {set lastsend $flowctl($dest,$conn,lastsend)}]} {
46                set lastsend 0
47            }
48            set now [clock seconds]
49            set lim $flowctl(sendlimit)
50            if {[expr $now - $lastsend] < $lim} {
51                lappend flowctl($dest,$conn,queue) $item
52                set wait [expr ($lim - ($now - $lastsend)) * 1000]
53                set flowctl($dest,$conn,after) \
54                        [after $wait [list ::irk::sender $dest $conn]]
55            } else {
56                set flowctl($dest,$conn,lastsend) $now
57                puts $conn $item
58            }
59        }
60
61        return ""
62    }
63
64    # This procedure does the sending when flow control for a connection
65    # is activated.
66
67    proc sender {dest conn} {
68        variable flowctl
69
70        # First of all clear the after entry.
71
72        unset flowctl($dest,$conn,after)
73
74        # Grab the first item on the queue:
75
76        if {[info exists flowctl($dest,$conn,queue)]} {
77            set items $flowctl($dest,$conn,queue)
78            if {[string compare $items ""]} {
79                set item [lindex $items 0]
80                set rest [lrange $items 1 end]
81                if {[string compare $rest ""]} {
82                    set lim [expr $flowctl(sendlimit) * 1000]
83                    set flowctl($dest,$conn,queue) $rest
84                    set flowctl($dest,$conn,after) \
85                            [after $lim [list ::irk::sender $dest $conn]]
86                } else {
87                    unset flowctl($dest,$conn,queue)
88                }
89
90                # Record time we last sent to this destination.
91
92                set flowctl($dest,$conn,lastsend) [clock seconds]
93
94                # Send this item:
95
96                puts $conn $item
97            } else {
98                unset flowctl($dest,$conn,queue)
99            }
100        }
101    }
102}
103
Note: See TracBrowser for help on using the repository browser.