1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#***
# [manpage_begin router tclircc 0.0.1]
# [titledesc {Component router.tcl}]
# [description]
namespace eval router {
variable routes [list main [thread::id]]
variable log [logger::init tclircc::router]
variable r_ns_script {
namespace eval ::r {
variable ns
variable self
proc update {} {
variable ns
thread::send -head [set ns(main)] ::router::update
}
proc ns {name} {
variable ns
set ns($name)
}
proc debug {} {
variable log
parray r::ns
}
proc util_regsub_prep {data} {
set first -1
while {[set first [string first \\ $data $first+1]] != -1} {
if {[string index $data $first+1] ni {0 1 2 3 4 5 6 7 8 9}} {
continue
}
set data [string replace $data $first $first \\\\]
incr first
}
set first -1
while {[set first [string first & $data $first+1]] != -1} {
set data [string replace $data $first $first {\&}]
incr first
}
return $data
}
proc util_pctsub {script} {
set new_script {}
set idx 0
while {[set subst_start [string first "%" $script $idx]] != -1} {
append new_script [string range $script $idx $subst_start-1]
if {[string index $script $subst_start+1] == "%"} {
append new_script %
set idx [expr {$subst_start + 2}]
continue
}
regexp -start [expr {$subst_start + 1}] -indices {[^A-Za-z0-9_:]} $script match
if {[llength $match]} {
lassign $match subst_end
set subst_end $subst_end-1
} else {
set subst_end [string length $script]
}
upvar [string range $script $subst_start+1 $subst_end] subst_data
append new_script $subst_data
set idx [expr $subst_end + 1]
}
append new_script [string range $script $idx end]
return $new_script
}
proc exec {name script {followup {}}} {
variable ns
variable self
set script [uplevel [list ::r::util_pctsub $script]]
set followup [uplevel [list ::r::util_pctsub $followup]]
if [string length $followup] {
set realscript {
set result [eval %script]
set script [concat [list set result $result] ";" %followup]
thread::send -async [r::ns %self] $script
}
regsub %self $realscript [util_regsub_prep [list $self]] realscript
regsub %followup $realscript [util_regsub_prep [list $followup]] realscript
regsub %script $realscript [util_regsub_prep [list $script]] realscript
set script $realscript
}
thread::send -async [set ns($name)] $script
}
}
}
eval $r_ns_script
set ::r::self "main"
proc manage {tid name} {
variable routes
variable log
variable r_ns_script
dict set routes $name $tid
${log}::debug "managing thread $tid as \"$name\""
thread::send -head $tid [concat $r_ns_script ";" [list set ::r::self $name]]
::router::update
}
proc unmanage {name} {
variable routes
variable log
dict unset routes $name
${log}::debug "unmanaging thread $tid (\"$name\")"
::router::update
}
proc update {} {
variable routes
dict for {name tid} $routes {
if ![thread::exists $tid] {dict unset routes $name}
}
dict for {name tid} $routes {
set payload {array unset r::ns; }
dict for {n t} $routes {
append payload [list array set r::ns [list $n $t]] ";\n"
}
append payload {
if {"on_routes_update" in [info procs on_routes_update]} \
on_routes_update
}
thread::send -head $tid $payload
}
::update
}
}
#***
# [manpage_end]