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