[2.101717.154] 10/17/17 at 10:07 PM | 1 updated tm modules | by DashBot

Author: bradennapier

cluster-1.1.6.tm cluster-1.1.7.tmcluster-1.1.6.tm renamed to cluster-1.1.7.tm

@@ -170,11 +170,13 @@ if 0 {
 }
 proc ::cluster::join args {
   set config $::cluster::DEFAULT_CONFIG
+
   if { [dict exists $args -protocols] } {
     set protocols [dict get $args -protocols]
   } else {
     set protocols [dict get $config protocols]
   }
+
   dict for { k v } $args {
     set k  [string trimleft $k -]
     if { ! [dict exists $config $k] && $k ni $protocols } {
@@ -188,7 +190,7 @@ proc ::cluster::join args {
     }
     dict set config $k $v
   }
-  
+
   # in case a boolean is passed to remote value, we convert to number
   # style boolean
   set remote [dict get $config remote]

cluster/classes/cluster/cluster-api.tcl

@@ -35,7 +35,14 @@
 # removed from our cache.
 ::oo::define ::cluster::cluster method ttl  {} { return [dict get $CONFIG ttl] }
 
-::oo::define ::cluster::cluster method protocols {} { return [dict get $CONFIG protocols] }
+::oo::define ::cluster::cluster method protocols {{objects false}} {
+  if {$objects} {
+    return [info commands ${NS}::protocols::*]
+  } else {
+    return [dict get $CONFIG protocols] 
+  }
+
+}
 
 ::oo::define ::cluster::cluster method protocol { protocol } {
   if { [dict exists $PROTOCOLS $protocol] } {

cluster/classes/cluster/cluster.tcl

@@ -84,7 +84,7 @@
   set PROTOCOLS [dict create]
   namespace eval ${NS}::protocols {}
   foreach protocol [dict get $CONFIG protocols] {
-    if { [info commands ::cluster::protocol::$protocol] ne {} } {
+    if {[info commands ::cluster::protocol::$protocol] ne {}} {
       dict set PROTOCOLS $protocol \
         [::cluster::protocol::$protocol create \
           ${NS}::protocols::$protocol [self] $ID $CONFIG

cluster/protocols/cluster-unix.tcl

@@ -30,10 +30,28 @@ if {[info commands ::cluster::protocol::u] eq {}} {
 }
 
 ::oo::define ::cluster::protocol::u method SetServerPath config {
-  set SERVER_PATH [file normalize \
+  set path [file normalize \
     [file nativename [dict get $config u path]]
   ]
-  append SERVER_PATH - [$CLUSTER sid]
+
+  set filename [file tail $path]
+  set dir      [file dirname $path]
+
+  set extidx [string last "." $filename]
+
+  # index
+  if {$extidx != -1 && $extidx != 0} {
+    set ext      [string range $filename $extidx end]
+    set filename [string range $filename 0 end-[string length $ext]]
+  } else {
+    set ext {}
+  }
+  set SERVER_PATH [file join \
+    $dir \
+    ${filename}-[$CLUSTER sid]${ext}
+  ]
+
+  puts $SERVER_PATH
 }
 
 ::oo::define ::cluster::protocol::u method CreateStream {} {

tcl-modules/bpacket-1.0.0.tm

@@ -0,0 +1,141 @@
+if 0 {
+  @ bpacket @
+    binary packet is used to encode and decode data in a way that
+    is similar to protocol buffers.
+
+    it is composed of various parts.  data is encoded using a given
+    template and the template is used on each end to encode/decode
+    for communication.
+
+  @type BPTemplate
+    | This builds our binary format template.  It is utilized by both the
+    | encoding and decoding end to understand how to build and parse our
+    | binary packets automatically.
+  TODO:
+    * asterix items are marked as required, although this is not
+    * currently enforced.
+
+    > Format
+      {(*)? (type_name) (...type_args) | (field_num)}
+  @example
+  {
+    set template {
+      1  flags   props | type channel
+      2  string  hid
+      3  string  sid
+      4  numlist nlist | known
+      5  varint  timestamp
+      6  list    protocols
+      7  string  ruid
+      8  string  op
+      9  raw     raw
+      10 list    tags
+      11 boolean keepalive
+      12 list    filter
+      13 string  error
+      14 dict    data | {
+        first_name
+        last_name
+        phone_number
+        address
+        employer
+      }
+    }
+    set data [dict create \
+      timestamp [clock microseconds] \
+      hid       00:00:00:00:00:00 \
+      sid       a-7898 \
+      props     [list 0 10] \
+      protocols [list a b c] \
+      ruid      MY_EVENT \
+      keepalive true \
+      data [dict create \
+        first_name john \
+        last_name  smith \
+        phone_number 6665554444 \
+        address "Some address can go here" \
+        employer "Acme, Inc"
+      ]
+    ]
+  }
+}
+
+set template {
+  1 boolean compact
+  2 varint schema
+}
+
+namespace eval ::bpacket {
+  namespace ensemble create
+  namespace export {[a-z]*}
+
+  # the value used to indiciate the start of the header
+  variable HEADER "\xC0\x8D"
+  # end of packet - should not be the same as HEADER as we
+  # will remove any number of $EOF THEN look for HEADER to
+  # determine if we have multiple packets concatted
+  variable EOF "\x00\x00"
+
+  # holds a hash map of $id -> $type and $type -> $id
+  # of types that have been registered.
+  #
+  # types are required & registered when they are required by a template
+  if {![info exists ::bpacket::REGISTRY]} {
+    variable REGISTRY [dict create]
+  }
+
+  # these types are required and will be required automatically
+  # regardless of the given template.
+  variable REQUIRED_TYPES [list varint string]
+}
+
+namespace eval ::bpacket::decode {
+  namespace ensemble create
+  namespace export {[a-z]*}
+}
+
+namespace eval ::bpacket::encode {
+  namespace ensemble create
+  namespace export {[a-z]*}
+}
+
+namespace eval ::bpacket::type {
+  namespace ensemble create
+  namespace export {[a-z]*}
+}
+
+source -encoding utf-8 [file join \
+  [file dirname \
+    [file normalize [info script]] \
+  ] \
+  bpacket \
+  utils.tcl
+]
+
+if 0 {
+  @ bpacket create | $type $name ...$args
+    Allows creation of the various bpacket classes
+  @arg type {io|stream}
+    @type {io}
+      creates a bpacket io object which is responsible for both
+      encoding and decoding bpackets
+    @type {stream}
+      creates a bpacket stream object which receives a stream of
+      data and outputs valid bpackets when they are found
+  @arg name {string}
+  @arg args
+    @if | $type {io}
+      @arg template {BPTemplate}
+        the template that the given io handler should use.
+}
+proc ::bpacket::create {type name args} {
+  switch -nocase -- $type {
+    io {
+      package require bpacket::classes::io
+    }
+    stream {
+      package require bpacket::classes::stream
+    }
+  }
+  tailcall ::bpacket::classes::[string tolower $type] create $name {*}$args
+}