1 package require Tcl 8.5
4 package require json::write
7 namespace eval ::ten:: {
8 set library [file dirname [info script]]
10 proc nofuture {args} {}
13 snit::type ten::connector::perl {
16 set conn_fh [open {|object-remote-node} r+]
17 set firstline [gets $conn_fh]
20 default { error "Expected Shere, got $firstline" }
23 set channel [ten::read_channel %AUTO% -fh $conn_fh]
26 ten::connection %AUTO% -send_to_fh $conn_fh -read_channel $channel
33 snit::type ten::connection {
39 $self configurelist $args
40 fconfigure $options(-send_to_fh) -buffering none
41 $options(-read_channel) configurelist [list \
42 -on_line_call [ mymethod Receive ] \
43 -on_close_call [ mymethod ChannelClosed ] \
47 method Receive {line} {
48 set tcl_line [ json::json2dict $line ]
49 set type [ lindex $tcl_line 0 ]
50 set rest [ lrange $tcl_line 1 end ]
51 $self "receive_$type" {*}$rest
54 method receive_call_free {future_id id args} {
55 $self receive_call $future_id $id "" {*}$args
56 $self receive_free $id
59 method receive_call {future_id id args} {
60 if {$future_id == "NULL"} {
61 set future ten::nofuture
65 $self Invoke $future $id {*}$args
68 method receive_free {id} {
72 method Invoke {future local ctx method args} {
73 set result [$local $method {*}$args]
77 method ChannelClosed {} {
81 method send {message_type args} {
82 set future [ten::future %AUTO%]
84 [ json::write string $message_type ] \
85 [ json::write string $future ] \
92 method Send {to_send} {
93 set send_this [ json::write array {*}$to_send ]
94 puts $options(-send_to_fh) $send_this
98 snit::type ten::future {
100 variable callbacks ""
104 variable retain_count 1
107 if [$self is_ready] {
108 error "Future $self already completed"
115 if [$self is_ready] {
116 error "Future $self already completed"
122 method on_ready {cb_code} {
123 if [$self is_ready] {
124 eval [concat $cb_code $self]
126 lappend callbacks [list ready $cb_code]
130 method on_done {cb_code} {
131 if [llength $result] {
132 eval [concat $cb_code [list $result]]
134 lappend callbacks [list done $cb_code]
138 method on_fail {cb_code} {
139 if [llength $failure] {
140 eval [concat $cb_code [list $failure]]
142 lappend callbacks [list fail $cb_code]
146 method MarkReady {} {
148 foreach cb $callbacks {
149 set cb_type [lindex $cb 0]
150 set cb_code [lindex $cb 1]
152 ready { eval [concat $cb_code $self] }
154 if ![$self is_failure] {
155 eval [concat $cb_code [list $result]]
159 if [$self is_failure] {
160 eval [concat $cb_code [list $failure]]
167 method AssertReady {} {
169 error "Future not ready"
173 method is_ready {} { return $is_ready }
177 if [$self is_failure] {
183 method is_failure {} {
185 if [llength $failure] {
196 method await_ready {} {
197 vwait "${selfns}::is_ready"
200 method await_get {} {
203 if [$self is_failure] {
204 set err [$self failure]
218 set retain_count [ expr $retain_count - 1 ]
219 if {$retain_count == 0} {
225 snit::type ten::read_channel {
227 option -on_close_call
231 $self configurelist $args
232 fconfigure $options(-fh) -blocking 0
233 fileevent $options(-fh) readable [mymethod ReceiveData]
236 method ReceiveData {} {
237 set chan $options(-fh)
239 if [llength $options(-on_close_call)] {
240 eval $options(-on_close_call)
243 if [llength $options(-on_line_call)] {
244 while {[llength [set line [gets $chan]]] > 0} {
245 eval [concat $options(-on_line_call) [ list $line ]]
252 package provide ten 0.0.1