ten::handle class

[scpubgit/TenDotTcl.git] / ten / ten.tcl

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 connect {} {
    set conn_fh [open {|object-remote-node} r+]
    set firstline [gets $conn_fh]
    switch $firstline {
      Shere {}
      default { error "Expected Shere, got $firstline" }
    }

    set channel [ten::read_channel %AUTO% -fh $conn_fh]

    set conn [
      ten::connection %AUTO% -send_to_fh $conn_fh -read_channel $channel
    ]

    return $conn
  }
}

snit::type ten::connection {

  option -send_to_fh
  option -read_channel

  constructor {args} {
    $self configurelist $args
    fconfigure $options(-send_to_fh) -buffering none
    $options(-read_channel) configurelist [list \
      -on_line_call [ mymethod Receive ] \
      -on_close_call [ mymethod ChannelClosed ] \
    ]
  }

  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 {} {
    error "Fail"
  }

  method send {message_type args} {
    set future [ten::future %AUTO%]
    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 is_ready 0
  variable result ""
  variable failure ""
  variable retain_count 1
  
  method done {args} {
    if [$self is_ready] {
      error "Future $self already completed"
    }
    set result $args
    $self MarkReady
  }

  method fail {args} {
    if [$self is_ready] {
      error "Future $self already completed"
    }
    set failure $args
    $self MarkReady
  }

  method on_ready {cb_code} {
    if [$self is_ready] {
      eval [concat $cb_code $self]
    } else {
      lappend callbacks [list ready $cb_code]
    }
  }

  method on_done {cb_code} {
    if [llength $result] {
      eval [concat $cb_code [list $result]]
    } else {
      lappend callbacks [list done $cb_code]
    }
  }

  method on_fail {cb_code} {
    if [llength $failure] {
      eval [concat $cb_code [list $failure]]
    } else {
      lappend callbacks [list fail $cb_code]
    }
  }

  method MarkReady {} {
    set is_ready 1
    foreach cb $callbacks {
      set cb_type [lindex $cb 0]
      set cb_code [lindex $cb 1]
      switch $cb_type {
        ready { eval [concat $cb_code $self] }
        done {
          if ![$self is_failure] {
            eval [concat $cb_code [list $result]]
          }
        }
        failed {
          if [$self is_failure] {
            eval [concat $cb_code [list $failure]]
          }
        }
      }
    }
  }

  method AssertReady {} {
    if {!$is_ready} {
      error "Future not ready"
    }
  }

  method is_ready {} { return $is_ready }

  method get {} {
    $self AssertReady
    if [$self is_failure] {
      error $failure
    }
    return $result
  }

  method is_failure {} {
    $self AssertReady
    if [llength $failure] {
      return 1
    }
    return 0
  }

  method failure {} {
    $self AssertReady
    return $failure
  }

  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 {
  option -fh
  option -on_close_call
  option -on_line_call

  constructor {args} {
    $self configurelist $args
    fconfigure $options(-fh) -blocking 0
    fileevent $options(-fh) readable [mymethod ReceiveData]
  }

  method ReceiveData {} {
    set chan $options(-fh)
    if [eof $chan] {
      if [llength $options(-on_close_call)] {
        eval $options(-on_close_call)
      }
    } else {
      if [llength $options(-on_line_call)] {
        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