Edinburgh Speech Tools  2.4-release
 All Classes Functions Variables Typedefs Enumerations Enumerator Friends Pages
siod_fringe.cc
1  /************************************************************************/
2  /* */
3  /* Centre for Speech Technology Research */
4  /* University of Edinburgh, UK */
5  /* Copyright (c) 1996,1997 */
6  /* All Rights Reserved. */
7  /* */
8  /* Permission is hereby granted, free of charge, to use and distribute */
9  /* this software and its documentation without restriction, including */
10  /* without limitation the rights to use, copy, modify, merge, publish, */
11  /* distribute, sublicense, and/or sell copies of this work, and to */
12  /* permit persons to whom this work is furnished to do so, subject to */
13  /* the following conditions: */
14  /* 1. The code must retain the above copyright notice, this list of */
15  /* conditions and the following disclaimer. */
16  /* 2. Any modifications must be clearly marked as such. */
17  /* 3. Original authors' names are not deleted. */
18  /* 4. The authors' names are not used to endorse or promote products */
19  /* derived from this software without specific prior written */
20  /* permission. */
21  /* */
22  /* THE UNIVERSITY OF EDINBURGH AND THE CONTRIBUTORS TO THIS WORK */
23  /* DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING */
24  /* ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT */
25  /* SHALL THE UNIVERSITY OF EDINBURGH NOR THE CONTRIBUTORS BE LIABLE */
26  /* FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES */
27  /* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN */
28  /* AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, */
29  /* ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF */
30  /* THIS SOFTWARE. */
31  /* */
32  /*************************************************************************/
33  /* */
34  /* Author: Richard Caley (rjc@cstr.ed.ac.uk) */
35  /* -------------------------------------------------------------------- */
36  /* Functions to talk to fringe. */
37  /* */
38  /*************************************************************************/
39 
40 #include "siod.h"
41 #include "EST_FringeServer.h"
42 
43 static bool have_read_table=FALSE;
44 
45 static int tc_fringe_server= -1;
46 
47 // SIOD support for fringe server objects
48 
49 EST_FringeServer *get_c_fringe_server(LISP x)
50 {
51  if (TYPEP(x,tc_fringe_server))
52  return (EST_FringeServer *)USERVAL(x);
53  else
54  err("wrong type of argument to get_c_fringe_server",x);
55 
56  return NULL; // err doesn't return but compilers don't know that
57 }
58 
59 int siod_fringe_server_p(LISP x)
60 {
61  if (TYPEP(x,tc_fringe_server))
62  return TRUE;
63  else
64  return FALSE;
65 }
66 
67 LISP siod_make_fringe_server(EST_FringeServer *s)
68 {
69  if (s==0)
70  return NIL;
71  else
72  return siod_make_typed_cell(tc_fringe_server,s);
73 }
74 
75 static void fringe_server_free(LISP lserver)
76 {
77  EST_FringeServer *server = get_c_fringe_server(lserver);
78  delete server;
79  USERVAL(lserver) = NULL;
80 }
81 
82 // Deal with the server table.
83 
84 LISP fringe_read_server_table(LISP args)
85 {
86  if (NULLP(args))
88  else
89  EST_ServiceTable::read_table(get_c_string(CAR(args)));
90 
91  have_read_table=TRUE;
92 
93  return NIL;
94 }
95 
96 LISP fringe_servers(void)
97 {
98  EST_StrList names;
100 
101  if (!have_read_table)
102  fringe_read_server_table(NIL);
103 
104  LISP lnames = NIL;
105 
107 
108  for(p.begin(names); p; ++p)
109  lnames = cons(strcons((*p).length(), *p), lnames);
110 
111  return lnames;
112 }
113 
114 // Creating and connecting to servers.
115 
116 static void fringe_connect(EST_FringeServer *server)
117 {
118  switch (server->connect())
119  {
120  case connect_ok:
121  break;
122 
123  case connect_not_found_error:
124  EST_sys_error("Can't find host '%s:%d'", (const char *)server->servername(), server->port());
125  break;
126 
127  case connect_not_allowed_error:
128  EST_sys_error("Can't connect to '%s:%d'", (const char *)server->servername(), server->port());
129  break;
130 
131  default:
132  EST_sys_error("Error connecting to '%s:%d'", (const char *)server->servername(), server->port());
133  break;
134  }
135 }
136 
137 LISP fringe_server(LISP lname)
138 {
139  if (CONSP(lname))
140  lname = CAR(lname);
141 
142  EST_String name=NULLP(lname)?"fringe":get_c_string(lname);
143 
144  if (!have_read_table)
145  fringe_read_server_table(NIL);
146 
147  LISP verbose = siod_get_lval("fringe_verbose", NULL);
148 
149  EST_FringeServer *server = new EST_FringeServer(name, !NULLP(verbose)?&cout:(ostream *)NULL);
150 
151  fringe_connect(server);
152 
153  return siod_make_fringe_server(server);
154 }
155 
156 static EST_FringeServer *get_server(LISP lserver, bool &my_server)
157 {
158  if (siod_fringe_server_p(lserver))
159  my_server=false;
160  else
161  {
162  my_server=true;
163  lserver = fringe_server(lserver);
164  }
165 
166  return get_c_fringe_server(lserver);
167 }
168 
169 LISP fringe_connect(LISP lserver)
170 {
171  if (!siod_fringe_server_p(lserver))
172  EST_error("not a fringe server %s", get_c_string(lserver));
173 
174  EST_FringeServer *server = get_c_fringe_server(lserver);
175 
176  if (server->connected())
177  fringe_connect(server);
178 
179  return NIL;
180 }
181 
182 LISP fringe_disconnect(LISP lserver)
183 {
184  if (!siod_fringe_server_p(lserver))
185  EST_error("not a fringe server %s", get_c_string(lserver));
186 
187  EST_FringeServer *server = get_c_fringe_server(lserver);
188 
189  if (server->connected())
190  server->disconnect();
191  return NIL;
192 }
193 
194 LISP fringe_command_string(LISP lserver,
195  LISP lcommand)
196 {
197  EST_String command=get_c_string(lcommand);
198 
199  bool my_server;
200 
201  EST_FringeServer *server = get_server(lserver, my_server);
202 
203  if (!server->connected())
204  fringe_connect(server);
205 
207 
208  EST_FringeServer::Result &res = handler.res;
209 
210  if (!server->execute(command, handler))
211  {
212  EST_String err = res.S("ERROR");
213  if (my_server)
214  delete server;
215  return strcons(err.length(), err);
216  }
217 
218  if (my_server)
219  delete server;
220 
221  return NIL;
222 }
223 
224 LISP fringe_command(LISP lserver,
225  LISP lpackage,
226  LISP loperation,
227  LISP largs)
228 {
229  bool my_server;
230 
231  EST_FringeServer *server = get_server(lserver, my_server);
232 
233  EST_String package = NULLP(lpackage)?"":get_c_string(lpackage);
234  EST_String operation = NULLP(loperation)?"":get_c_string(loperation);
235 
237 
238  if (!LISTP(largs))
239  EST_error("Bad argument list");
240 
241  lisp_to_features(largs, args);
242 
244  EST_FringeServer::Result &res = handler.res;
245 
246  if (!server->connected())
247  fringe_connect(server);
248 
249  if (!server->execute(package, operation, args, handler))
250  {
251  EST_String err = res.S("ERROR");
252  if (my_server)
253  delete server;
254  return strcons(err.length(), err);
255  }
256 
257  if (my_server)
258  delete server;
259 
260  return NIL;
261 }
262 
263 void siod_fringe_init()
264 {
265  long kind;
266 
267  tc_fringe_server = siod_register_user_type("FringeServer");
268  set_gc_hooks(tc_fringe_server, 0, NULL,NULL,NULL,fringe_server_free,NULL,&kind);
269 
270 
271  init_lsubr("fringe_read_server_table", fringe_read_server_table,
272  "(fringe_read_server_table &opt FILENAME)\n"
273  " Read the users table of fringe servers, or the table\n"
274  " in FILENAME if given.");
275 
276  init_subr_0("fringe_servers", fringe_servers,
277  "(fringe_servers)\n"
278  " Returns a list of the know fringe servers. This doesn't\n"
279  " guarantee that they are still running.");
280 
281  init_lsubr("fringe_server", fringe_server,
282  "(fringe_server &opt NAME)\n"
283  " Return a connection to a fringe server with the given name.\n"
284  " If name is omitted it defaults to \"fringe\".");
285 
286  init_subr_1("fringe_disconnect", fringe_disconnect,
287  "(fringe_disconnect SERVER)\n"
288  " Close the connection to the server.");
289 
290  init_subr_1("fringe_connect", fringe_connect,
291  "(fringe_connect SERVER)\n"
292  " Re-open the connection to the server.");
293 
294  init_subr_2("fringe_command_string", fringe_command_string,
295  "(fringe_command_string SERVER COMMAND)\n"
296  " Send COMMAND to the fringe server SERVER.");
297 
298  init_subr_4("fringe_command", fringe_command,
299  "(fringe_command SERVER PACKAGE OPERATION ARGS) \n"
300  " Send command to the fringe server SERVER.\n"
301  " ARGS should be an association list of key-value pairs.");
302 }