Skip to content

Commit 5cbe3dd

Browse files
bradennapierbradennapier
committed
add inline documentation
1 parent 8fd47e3 commit 5cbe3dd

File tree

4 files changed

+365
-167
lines changed

4 files changed

+365
-167
lines changed

‎cluster-1.0.0.tm‎

Lines changed: 177 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,177 @@
1+
namespace eval ::cluster {
2+
namespace ensemble create
3+
namespace export {[a-z]*}
4+
5+
namespace eval cluster {}
6+
namespace eval protocol {}
7+
}
8+
9+
# Source our general utilities first since they
10+
# are needed for the evaluation below.
11+
source [file join \
12+
[file dirname [file normalize [info script]]] utils general.tcl
13+
]
14+
15+
% {
16+
@type ClusterCommunicationProtocol {mixed}
17+
| A ClusterCommunicationProtocol is any of the supported
18+
| protocols as provided within the [protocols] folder.
19+
| Generally these will be a single-character representation
20+
| as an example, "tcp" is "t" while "udp" is "u" and so-on.
21+
22+
@type MulticastAddress {IP}
23+
| An IP Addresss within the range 224.0.0.0 to 239.255.255.255
24+
25+
@type ClusterCommConfiguration {dict}
26+
| Our default configuration for the cluster. This
27+
| dict also represents the configuration options
28+
| that are available when calling [::cluster::join]
29+
@prop address {MulticastAddress}
30+
The address that should be used as the multicast address
31+
@prop port /[0-65535]/
32+
The UDP multicast port that should be used
33+
@prop ttl {entier}
34+
How many seconds should a service live if it is not seen?
35+
@prop heartbeat {entier}
36+
At what interval should we send heartbeats to the cluster?
37+
@prop protocols {list<ClusterCommunicationProtocol>}
38+
A list providing the communication protocols that should be
39+
supported / advertised to our peers. The list should be in
40+
order of desired priority. Our peers will attempt to honor
41+
this priority when opening channels of communication with us.
42+
@prop channels {list<entier>}
43+
A list of communication channels that we should join.
44+
@prop remote {boolean}
45+
Should we listen outside of localhost? When set to false,
46+
the ttl of our multicasts will be set to 0 so that they
47+
do not leave the local system.
48+
}
49+
50+
% {
51+
@ ::cluster::cluster @ {class}
52+
| $::cluster::cluster instances are created for each cluster that
53+
| is joined.
54+
}
55+
::oo::class create ::cluster::cluster {}
56+
57+
% {
58+
@ ::cluster::services @ {class}
59+
| Each discovered service (member of a cluster) will be
60+
| an instance of our $::cluster::services class.
61+
}
62+
::oo::class create ::cluster::service {}
63+
64+
% {
65+
@ $::cluster::addresses {?list<IP>?}
66+
| Used to store our systems local IP Addresses. Primed by
67+
| calling [::cluster::local_addresses]
68+
}
69+
variable ::cluster::addresses [list]
70+
71+
% {
72+
@ $::cluster::i @ {entier}
73+
| A counter value used to generate unique session values
74+
}
75+
variable ::cluster::i 0
76+
77+
% {
78+
@ $::cluster::DEFAULT_CONFIG @ {ClusterCommConfiguration}
79+
}
80+
variable ::cluster::DEFAULT_CONFIG [dict create \
81+
address 230.230.230.230 \
82+
port 23000 \
83+
ttl 600 \
84+
heartbeat [::cluster::rand 110000 140000] \
85+
protocols [list t c] \
86+
channels [list] \
87+
remote false \
88+
tags [list]
89+
]
90+
91+
% {
92+
@ ::cluster::source
93+
| Called when cluster is required. It will source all the
94+
| necessary scripts in our sub-directories. Once completed,
95+
| the proc is removed via [rename]
96+
}
97+
proc ::cluster::source {} {
98+
set utils_directory [file join [file dirname [file normalize [info script]]] utils]
99+
foreach file [glob -directory $utils_directory *.tcl] {
100+
if {[string match *general.tcl $file]} { continue }
101+
uplevel #0 [list source $file]
102+
}
103+
set bpacket_directory [file join [file dirname [file normalize [info script]]] bpacket]
104+
foreach file [glob -directory $bpacket_directory *.tcl] {
105+
uplevel #0 [list source $file]
106+
}
107+
set classes_directory [file join [file dirname [file normalize [info script]]] classes]
108+
foreach file [glob -directory $classes_directory *.tcl] {
109+
uplevel #0 [list source $file]
110+
}
111+
set protocol_directory [file join [file dirname [file normalize [info script]]] protocols]
112+
foreach file [glob -directory $protocol_directory *.tcl] {
113+
uplevel #0 [list source $file]
114+
}
115+
116+
rename ::cluster::source {}
117+
}
118+
119+
% {
120+
@type ClusterCommConfiguration {dict}
121+
| Our default configuration for the cluster. This
122+
| dict also represents the configuration options
123+
| that are available when calling [::cluster::join]
124+
@prop address {MulticastAddress}
125+
The address that should be used as the multicast address
126+
@prop port {/[0-65535]/}
127+
The UDP multicast port that should be used
128+
@prop ttl {entier}
129+
How many seconds should a service live if it is not seen?
130+
@prop heartbeat {entier}
131+
At what interval should we send heartbeats to the cluster?
132+
@prop protocols {list<ClusterCommunicationProtocol>}
133+
A list providing the communication protocols that should be
134+
supported / advertised to our peers. The list should be in
135+
order of desired priority. Our peers will attempt to honor
136+
this priority when opening channels of communication with us.
137+
@prop channels {list<entier>}
138+
A list of communication channels that we should join.
139+
@prop remote {boolean}
140+
Should we listen outside of localhost? When set to false,
141+
the ttl of our multicasts will be set to 0 so that they
142+
do not leave the local system.
143+
144+
@ ::cluster::join
145+
| The core cluster command that is used as a factory to build
146+
| a new cluster instance. A $::cluster::cluster object
147+
| is returned which can then be used to communicate with our
148+
| cluster.
149+
@arg args {dict<-key, value> from ClusterCommConfiguration}
150+
args are a key/value pairing with the configuration key being
151+
prefixed with a dash (-) and the value that should be used
152+
as its pair value. (-ttl 600 -port 10)
153+
@returns {object<::cluster::cluster>}
154+
When called, returns an object that can be used to communicate
155+
with the cluster.
156+
}
157+
proc ::cluster::join args {
158+
set config $::cluster::DEFAULT_CONFIG
159+
if { [dict exists $args -protocols] } {
160+
set protocols [dict get $args -protocols]
161+
} else { set protocols [dict get $config protocols] }
162+
dict for { k v } $args {
163+
set k [string trimleft $k -]
164+
if { ! [dict exists $config $k] && $k ni $protocols } {
165+
throw error "Invalid Cluster Config Key: ${k}, should be one of [dict keys $config]"
166+
}
167+
if { [string equal $k protocols] } {
168+
# cluster protocol is required, add if defined without it
169+
if { "c" ni $v } { lappend v c }
170+
}
171+
dict set config $k $v
172+
}
173+
set id [incr ::cluster::i]
174+
return [::cluster::cluster create ::cluster::clusters::cluster_$id $id $config]
175+
}
176+
177+
::cluster::source

‎cluster_comm-1.0.tm‎

Lines changed: 0 additions & 87 deletions
This file was deleted.

‎utils/general.tcl‎

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
if { [info commands ::onError] eq {} } {
2+
# Our Error Handler is called throughout. If not defined, we define it
3+
# here.
4+
# TODO: Provide official way to handle the logging / errors.
5+
proc ::onError { result options args } {}
6+
}
7+
8+
if {[info commands %] eq {}} {
9+
# [%] is unfortunately required to be provided this way. While
10+
# this may cause side effects until the pre-processor is finished,
11+
# it is used as a standard for inline documentation throughout
12+
# Dash Packages.
13+
proc % args {}
14+
}
15+
16+
% {
17+
@ ::cluster::rand @
18+
| Generate a "random" number within the given range
19+
@arg min {entier} | minimum value
20+
@arg max {entier} | maximum value
21+
}
22+
proc ::cluster::rand {min max} {
23+
expr { int(rand() * ($max - $min + 1) + $min)}
24+
}
25+
26+
27+
proc ::cluster::query_id {} { incr ::cluster::i }
28+
29+
proc ::cluster::ifhook {hooks args} {
30+
if { [dict exists $hooks {*}$args] } {
31+
tailcall dict get $hooks {*}$args
32+
}
33+
}

0 commit comments

Comments
 (0)