1# Copyright (C) 1999-2000 Jean-Claude Wippler <jcw@equi4.com>
2#
3# Tequila  -  client interface to the Tequila server
4
5package provide tequila 1.5
6
7namespace eval tequila {
8    namespace export open close do attach
9
10    variable _socket
11    variable _reply
12
13        # setup communication with the tequila server
14    proc open {addr port} {
15        variable _socket
16        set _socket [socket $addr $port]
17        fconfigure $_socket -translation binary -buffering none
18        fileevent $_socket readable tequila::privRequest
19    }
20
21        # setup callback for when link to server fails
22    proc failure {cmd} {
23        variable _socket
24        trace variable _socket u $cmd
25    }
26
27        # terminate communication (this is usually not needed)
28    proc close {} {
29        variable _socket
30        ::close $_socket
31    }
32
33        # set up to pass almost all MK requests through to the server
34        # note that mk::loop is not implemented, is only works locally
35        # added 20-02-2000
36    proc proxy {} {
37        namespace eval ::mk {
38            foreach i {file view row cursor get set select channel} {
39                proc $i {args} "eval ::tequila::do Remote $i \$args"
40            }
41        }
42    }
43
44        # send a request to the server and wait for a response
45    proc do {args} {
46        variable _socket
47        variable _reply ""
48
49        catch {
50            puts -nonewline $_socket "[string length $args]\n$args"
51            while {[string length $_reply] == 0} {
52                vwait tequila::_reply
53            }
54        }
55
56        set error 0
57        set results ""
58        foreach {error results} $_reply break
59
60        if {[string compare $error 0] == 0} {
61            return $results
62        }
63
64        if {[string length $results] > 0} {
65            error $results
66        }
67
68        error "Failed network request to the server."
69    }
70
71        # prepare for automatic change propagation
72    proc attach {array args} {
73        array set opts {-fetch 1 -tracking 1 -type S}
74        array set opts $args
75
76        global $array
77        do Define $array 0 $opts(-type)
78
79        if {$opts(-fetch)} {
80            set command GetAll
81        } else {
82            set command Listing
83        }
84
85        array set $array [do $command $array $opts(-tracking)]
86
87        trace variable $array wu tequila::privTracer
88    }
89
90        # called whenever a request comes in (private)
91    proc privRequest {} {
92        variable _socket
93        variable _reply
94
95        if {[gets $_socket bytes] > 0} {
96            set request [read $_socket $bytes]
97            if ![eof $_socket] {
98                uplevel #0 tequila::privCallBack_$request
99                return
100            }
101        }
102            # trouble, make sure we stop a pending request
103        set _reply [list 1 "Lost connection with the tequila server."]
104        ::close $_socket
105        unset _socket
106    }
107
108        # handles traces to propagate changes to the server (private)
109    proc privTracer {a e op} {
110        if {$e != ""} {
111            switch $op {
112                w   { do Set $a $e [set ::${a}($e)] }
113                u   { do Unset $a $e }
114            }
115        }
116    }
117
118        # called by the server to return a result
119    proc privCallBack_Reply {args} {
120        variable _reply
121        set _reply $args
122    }
123
124        # called by the server to propagate an element write
125    proc privCallBack_Set {a e v} {
126        global $a
127        if {![info exists ${a}($e)] || [set ${a}($e)] != $v} {
128            trace vdelete $a wu tequila::privTracer
129            set ${a}($e) $v
130            trace variable $a wu tequila::privTracer
131        }
132    }
133
134        # called by the server to propagate an element delete
135    proc privCallBack_Unset {a e} {
136        global $a
137        if {[info exists ${a}($e)]} {
138            trace vdelete $a wu tequila::privTracer
139            unset ${a}($e)
140            trace variable $a wu tequila::privTracer
141        }
142    }
143}
144
145