-package require Tcl 8.4
+package require Tcl 8.5
package require snit
+package require json::write
+package require json
namespace eval ::ten:: {
set library [file dirname [info script]]
+
+ proc nofuture {args} {}
}
snit::type ten::connector::perl {
]
}
- method Receive {$line} {
- puts $line
+ method Receive {line} {
+ set tcl_line [ json::json2dict $line ]
+ set type [ lindex $tcl_line 0 ]
+ set rest [ lrange $tcl_line 1 end ]
+ $self "receive_$type" {*}$rest
+ }
+
+ method receive_call_free {future_id id args} {
+ $self receive_call $future_id $id "" {*}$args
+ $self receive_free $id
+ }
+
+ method receive_call {future_id id args} {
+ if {$future_id == "NULL"} {
+ set future ten::nofuture
+ } else {
+ set future $future_id
+ }
+ $self Invoke $future $id {*}$args
+ }
+
+ method receive_free {id} {
+ $id free
+ }
+
+ method Invoke {future local ctx method args} {
+ set result [$local $method {*}$args]
+ $future done $result
}
method ChannelClosed {} {
method send {message_type args} {
set future [ten::future %AUTO%]
- set call_args [concat $message_type $future $args]
+ set call_args [list \
+ [ json::write string $message_type ] \
+ [ json::write string $future ] \
+ {*}$args
+ ]
+ $self Send $call_args
+ return $future
+ }
+
+ method Send {to_send} {
+ set send_this [ json::write array {*}$to_send ]
+ puts $options(-send_to_fh) $send_this
}
}
snit::type ten::future {
- variable callbacks
+ variable callbacks ""
variable is_ready 0
variable result ""
variable failure ""
+ variable retain_count 1
method done {args} {
if [$self is_ready] {
}
method on_ready {cb_code} {
- lappend callbacks [list ready $cb_code]
+ if [$self is_ready] {
+ eval [concat $cb_code $self]
+ } else {
+ lappend callbacks [list ready $cb_code]
+ }
}
method on_done {cb_code} {
- lappend callbacks [list done $cb_code]
+ if [llength $result] {
+ eval [concat $cb_code [list $result]]
+ } else {
+ lappend callbacks [list done $cb_code]
+ }
}
method on_fail {cb_code} {
- lappend callbacks [list fail $cb_code]
+ if [llength $failure] {
+ eval [concat $cb_code [list $failure]]
+ } else {
+ lappend callbacks [list fail $cb_code]
+ }
}
method MarkReady {} {
return $failure
}
- method await {} {
+ method await_ready {} {
vwait "${selfns}::is_ready"
}
+
+ method await_get {} {
+ $self retain
+ $self await_ready
+ if [$self is_failure] {
+ set err [$self failure]
+ $self free
+ error $err
+ }
+ set res [$self get]
+ $self free
+ return $res
+ }
+
+ method retain {} {
+ incr retain_count
+ }
+
+ method free {} {
+ set retain_count [ expr $retain_count - 1 ]
+ if {$retain_count == 0} {
+ $self destroy
+ }
+ }
}
snit::type ten::read_channel {
}
} else {
if [llength $options(-on_line_call)] {
- while {[llength [set line [gets $chan]]] > 0} {
- eval [concat $options(-on_line_call) $line]
+ while {[string length [set line [gets $chan]]] > 0} {
+ eval [concat $options(-on_line_call) [ list $line ]]
}
}
}
}
}
+snit::type ten::handle {
+ option -connection
+ option -id
+
+ method call {name args} {
+ return [[$self start $name {*}$args] await_get]
+ }
+
+ method start {name args} {
+ $options(-connection) send call [json::write string $options(-id)] 0 [json::write string $name] {*}$args
+ }
+}
+
package provide ten 0.0.1