Commit | Line | Data |
3c6a0ce7 |
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 |