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
97 method remote_object {id} {
98 return [ten::handle %AUTO% -connection $self -id $id]
103 snit::type ten::future {
105 variable callbacks ""
109 variable retain_count 1
112 if [$self is_ready] {
113 error "Future $self already completed"
120 if [$self is_ready] {
121 error "Future $self already completed"
127 method on_ready {cb_code} {
128 if [$self is_ready] {
129 eval [concat $cb_code $self]
131 lappend callbacks [list ready $cb_code]
135 method on_done {cb_code} {
136 if [llength $result] {
137 eval [concat $cb_code [list $result]]
139 lappend callbacks [list done $cb_code]
143 method on_fail {cb_code} {
144 if [llength $failure] {
145 eval [concat $cb_code [list $failure]]
147 lappend callbacks [list fail $cb_code]
151 method MarkReady {} {
153 foreach cb $callbacks {
154 set cb_type [lindex $cb 0]
155 set cb_code [lindex $cb 1]
157 ready { eval [concat $cb_code $self] }
159 if ![$self is_failure] {
160 eval [concat $cb_code [list $result]]
164 if [$self is_failure] {
165 eval [concat $cb_code [list $failure]]
172 method AssertReady {} {
174 error "Future not ready"
178 method is_ready {} { return $is_ready }
182 if [$self is_failure] {
188 method is_failure {} {
190 if [llength $failure] {
201 method await_ready {} {
202 vwait "${selfns}::is_ready"
205 method await_get {} {
208 if [$self is_failure] {
209 set err [$self failure]
223 set retain_count [ expr $retain_count - 1 ]
224 if {$retain_count == 0} {
230 snit::type ten::read_channel {
232 option -on_close_call
236 $self configurelist $args
237 fconfigure $options(-fh) -blocking 0
238 fileevent $options(-fh) readable [mymethod ReceiveData]
241 method ReceiveData {} {
242 set chan $options(-fh)
244 if [llength $options(-on_close_call)] {
245 eval $options(-on_close_call)
248 if [llength $options(-on_line_call)] {
249 while {[string length [set line [gets $chan]]] > 0} {
250 eval [concat $options(-on_line_call) [ list $line ]]
257 snit::type ten::handle {
261 method call {name args} {
262 return [[$self start $name {*}$args] await_get]
265 method start {name args} {
266 $options(-connection) send call [json::write string $options(-id)] 0 [json::write string $name] {*}$args
270 package provide ten 0.0.1