ten/ten.tcl

   1 package require Tcl 8.4
   2
   3 package require snit
   4
   5 namespace eval ::ten:: {
   6   set library [file dirname [info script]]
   7 }
   8
   9 snit::type ten::connector::perl {
  10
  11   method connect {} {
  12     set conn_fh [open {|object-remote-node} r+]
  13     set firstline [gets conn_fh]
  14     switch $firstline {
  15       Shere {}
  16       default { error "Expected Shere, got $firstline" }
  17     }
  18
  19     set channel [ten::read_channel %AUTO% -fh $conn_fh]
  20
  21     set conn [
  22       ten::connection %AUTO% -send_to_fh $conn_fh -read_channel $channel
  23     ]
  24
  25     return $conn
  26   }
  27 }
  28
  29 snit::type ten::read_channel {
  30   option -fh
  31   option -on_close_call
  32   option -on_line_call
  33
  34   constructor {args} {
  35     $self configurelist $args
  36     fconfigure $options(-fh) -blocking 0
  37     fileevent $options(-fh) readable [mymethod ReceiveData]
  38   }
  39
  40   method ReceiveData {} {
  41     set chan $options(-fh)
  42     if [eof $chan] {
  43       if [llength $options(-on_close_call)] {
  44         eval $options(-on_close_call)
  45       }
  46     } else {
  47       if [llength $options(-on_line_call)] {
  48         while {[llength [set line [gets $chan]]] > 0} {
  49           eval [concat $options(-on_line_call) $line]
  50         }
  51       }
  52     }
  53   }
  54 }
  55
  56 package provide ten 0.0.01