From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 8 Sep 2012 18:27:24 +0000 (+0000)
Subject: working hostname call
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0e93bc12741bd93c6e35d81da4a44b32f7a8cdf9;p=scpubgit%2FTenDotTcl.git

working hostname call
---

diff --git a/t/connection.t b/t/connection.t
new file mode 100644
index 0000000..6ce7931
--- /dev/null
+++ b/t/connection.t
@@ -0,0 +1,22 @@
+BEGIN { exec(tclsh => 't/tcl/harness.tcl' => $0) }
+
+package require ten
+package require json::write
+
+set connector [ten::connector::perl %AUTO%]
+
+set conn [$connector connect]
+
+set f1 [
+  $conn send call [ json::write string class_call_handler ] \
+    0 [ json::write string call ] \
+    [ json::write string Sys::Hostname ] [ json::write string hostname ]
+]
+
+set ready_args ""
+
+$f1 on_ready [list apply {{name future} {set $name [$future get]}} "[namespace current]::ready_args" ]
+
+$f1 await_ready
+
+is $ready_args [exec hostname] "hostname returned ok"
diff --git a/t/tcl/harness.tcl b/t/tcl/harness.tcl
index 2856a1c..1872ce4 100644
--- a/t/tcl/harness.tcl
+++ b/t/tcl/harness.tcl
@@ -1,4 +1,4 @@
-lappend ::auto_path snit ten
+lappend ::auto_path json snit ten
 package require ten::test
 namespace import ten::test::*
 proc BEGIN {meh} {}
diff --git a/ten/ten.tcl b/ten/ten.tcl
index 0e22d50..3798233 100644
--- a/ten/ten.tcl
+++ b/ten/ten.tcl
@@ -1,9 +1,13 @@
-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 {
@@ -40,8 +44,34 @@ snit::type ten::connection {
     ]
   }
 
-  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 {} {
@@ -50,7 +80,18 @@ snit::type ten::connection {
 
   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
   }
 }
 
@@ -60,6 +101,7 @@ snit::type ten::future {
   variable is_ready 0
   variable result ""
   variable failure ""
+  variable retain_count 1
   
   method done {args} {
     if [$self is_ready] {
@@ -151,9 +193,20 @@ snit::type ten::future {
     return $failure
   }
 
-  method await {} {
+  method await_ready {} {
     vwait "${selfns}::is_ready"
   }
+
+  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 {
@@ -176,7 +229,7 @@ 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]
+          eval [concat $options(-on_line_call) [ list $line ]]
         }
       }
     }