scratch

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

package require Tcl 8.4

package require snit

namespace eval ::ten:: {
  set library [file dirname [info script]]
}

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} {
    puts $line
  }

  method ChannelClosed {} {
    error "Fail"
  }

  method send {message_type args} {
    set future [ten::future %AUTO%]
    $self Send [concat
      [list list "str $message_type" "str $future"] $args
    ]
  }

  method Send {to_send} {
    puts $options(-send_to_fh) [$self Serialize $to_send]
  }

  method Serialize {
  }
}

snit::type ten::future {

  variable callbacks ""
  variable is_ready 0
  variable result ""
  variable failure ""
  
  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 {} {
    vwait "${selfns}::is_ready"
  }
}

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 {[llength [set line [gets $chan]]] > 0} {
          eval [concat $options(-on_line_call) $line]
        }
      }
    }
  }
}

package provide ten 0.0.1