2 * IR toolkit for tcl/tk
5 * $Id: ir-tcl.c,v 1.2 1995-03-08 07:28:29 adam Exp $
27 int preferredMessageSize;
28 int maximumMessageSize;
30 Odr_bitmask protocolVersion;
31 char *idAuthentication;
32 char *implementationName;
33 char *implementationId;
55 int (*method) (void * obj, Tcl_Interp *interp, int argc, char **argv);
58 static int do_disconnect (void *obj,Tcl_Interp *interp, int argc, char **argv);
61 * get_parent_info: Returns information about parent object.
63 static int get_parent_info (Tcl_Interp *interp, const char *name,
64 Tcl_CmdInfo *parent_info)
66 char parent_name[128];
67 const char *csep = strrchr (name, '.');
72 interp->result = "missing .";
78 memcpy (parent_name, name, pos);
79 parent_name[pos] = '\0';
80 if (!Tcl_GetCommandInfo (interp, parent_name, parent_info))
86 * ir_method: Search for method in table and invoke method handler
88 int ir_method (void *obj, Tcl_Interp *interp, int argc, char **argv,
93 if (!strcmp (tab->name, argv[1]))
94 return (*tab->method)(obj, interp, argc, argv);
97 Tcl_AppendResult (interp, "unknown method: ", argv[1], NULL);
102 * ir_asc2bitmask: Ascii to ODR bitmask conversion
104 int ir_asc2bitmask (const char *asc, Odr_bitmask *ob)
106 const char *cp = asc + strlen(asc);
113 ODR_MASK_SET (ob, bitno);
120 * ir_strdup: Duplicate string
122 int ir_strdup (Tcl_Interp *interp, char** p, char *s)
124 *p = malloc (strlen(s)+1);
127 interp->result = "malloc fail";
134 /* ------------------------------------------------------- */
137 * do_init_request: init method on IR object
139 static int do_init_request (void *obj, Tcl_Interp *interp,
140 int argc, char **argv)
149 req.options = &p->options;
150 req.protocolVersion = &p->protocolVersion;
151 req.preferredMessageSize = &p->preferredMessageSize;
152 req.maximumRecordSize = &p->maximumMessageSize;
154 req.idAuthentication = p->idAuthentication;
155 req.implementationId = p->implementationId;
156 req.implementationName = p->implementationName;
157 req.implementationVersion = "0.1";
158 req.userInformationField = 0;
160 apdu.u.initRequest = &req;
161 apdu.which = Z_APDU_initRequest;
164 if (!z_APDU (p->odr_out, &apdup, 0))
166 interp->result = odr_errlist [odr_geterror (p->odr_out)];
167 odr_reset (p->odr_out);
170 sbuf = odr_getbuf (p->odr_out, &slen);
171 if (cs_put (p->cs_link, sbuf, slen) < 0)
173 interp->result = "cs_put failed in init";
176 printf("Sent initializeRequest (%d bytes).\n", slen);
181 * do_protocolVersion: Set protocol Version
183 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
184 int argc, char **argv)
187 ir_asc2bitmask (argv[2], &((IRObj *) obj)->protocolVersion);
192 * do_options: Set options
194 static int do_options (void *obj, Tcl_Interp *interp,
195 int argc, char **argv)
198 ir_asc2bitmask (argv[2], &((IRObj *) obj)->options);
203 * do_preferredMessageSize: Set preferred message size
205 static int do_preferredMessageSize (void *obj, Tcl_Interp *interp,
206 int argc, char **argv)
210 if (Tcl_GetInt (interp, argv[2],
211 &((IRObj *)obj)->preferredMessageSize)==TCL_ERROR)
214 sprintf (interp->result, "%d", ((IRObj *)obj)->preferredMessageSize);
219 * do_maximumMessageSize: Set maximum message size
221 static int do_maximumMessageSize (void *obj, Tcl_Interp *interp,
222 int argc, char **argv)
226 if (Tcl_GetInt (interp, argv[2],
227 &((IRObj *)obj)->maximumMessageSize)==TCL_ERROR)
230 sprintf (interp->result, "%d", ((IRObj *)obj)->maximumMessageSize);
236 * do_implementationName: Set Implementation Name.
238 static int do_implementationName (void *obj, Tcl_Interp *interp,
239 int argc, char **argv)
243 free (((IRObj*)obj)->implementationName);
244 if (ir_strdup (interp, &((IRObj*) obj)->implementationName, argv[2])
248 Tcl_AppendResult (interp, ((IRObj*)obj)->implementationName,
254 * do_implementationId: Set Implementation Name.
256 static int do_implementationId (void *obj, Tcl_Interp *interp,
257 int argc, char **argv)
261 free (((IRObj*)obj)->implementationId);
262 if (ir_strdup (interp, &((IRObj*) obj)->implementationId, argv[2])
266 Tcl_AppendResult (interp, ((IRObj*)obj)->implementationId,
272 * do_idAuthentication: Set id Authentication
274 static int do_idAuthentication (void *obj, Tcl_Interp *interp,
275 int argc, char **argv)
279 free (((IRObj*)obj)->idAuthentication);
280 if (ir_strdup (interp, &((IRObj*) obj)->idAuthentication, argv[2])
284 Tcl_AppendResult (interp, ((IRObj*)obj)->idAuthentication,
290 * do_connect: connect method on IR object
292 static int do_connect (void *obj, Tcl_Interp *interp,
293 int argc, char **argv)
300 interp->result = "missing hostname";
303 if (cs_type(p->cs_link) == tcpip_type)
305 addr = tcpip_strtoaddr (argv[2]);
308 interp->result = "tcpip_strtoaddr fail";
311 printf ("tcp/ip connect %s\n", argv[2]);
313 else if (cs_type (p->cs_link) == mosi_type)
315 addr = mosi_strtoaddr (argv[2]);
318 interp->result = "mosi_strtoaddr fail";
321 printf ("mosi connect %s\n", argv[2]);
323 if (cs_connect (p->cs_link, addr) < 0)
325 interp->result = "cs_connect fail";
326 do_disconnect (p, interp, argc, argv);
329 ir_select_add (cs_fileno (p->cs_link), p);
334 * do_disconnect: disconnect method on IR object
336 static int do_disconnect (void *obj, Tcl_Interp *interp,
337 int argc, char **argv)
341 ir_select_remove (cs_fileno (p->cs_link), p);
342 if (cs_type (p->cs_link) == tcpip_type)
344 cs_close (p->cs_link);
345 p->cs_link = cs_create (tcpip_type);
347 else if (cs_type (p->cs_link) == mosi_type)
349 cs_close (p->cs_link);
350 p->cs_link = cs_create (mosi_type);
354 interp->result = "unknown comstack type";
361 * do_comstack: comstack method on IR object
363 static int do_comstack (void *obj, Tcl_Interp *interp,
364 int argc, char **argv)
368 if (!strcmp (argv[2], "tcpip"))
369 ((IRObj *)obj)->cs_link = cs_create (tcpip_type);
370 else if (!strcmp (argv[2], "mosi"))
371 ((IRObj *)obj)->cs_link = cs_create (mosi_type);
374 interp->result = "wrong comstack type";
378 if (cs_type(((IRObj *)obj)->cs_link) == tcpip_type)
379 interp->result = "tcpip";
380 else if (cs_type(((IRObj *)obj)->cs_link) == mosi_type)
381 interp->result = "comstack";
386 * do_callback: add callback
388 static int do_callback (void *obj, Tcl_Interp *interp,
389 int argc, char **argv)
396 if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
404 * ir_obj_method: IR Object methods
406 static int ir_obj_method (ClientData clientData, Tcl_Interp *interp,
407 int argc, char **argv)
409 static IRMethod tab[] = {
410 { "comstack", do_comstack },
411 { "connect", do_connect },
412 { "protocolVersion", do_protocolVersion },
413 { "options", do_options },
414 { "preferredMessageSize", do_preferredMessageSize },
415 { "maximumMessageSize", do_maximumMessageSize },
416 { "implementationName", do_implementationName },
417 { "implementationId", do_implementationId },
418 { "idAuthentication", do_idAuthentication },
419 { "init", do_init_request },
420 { "disconnect", do_disconnect },
421 { "callback", do_callback },
426 interp->result = "wrong # args";
429 return ir_method (clientData, interp, argc, argv, tab);
433 * ir_obj_delete: IR Object disposal
435 static void ir_obj_delete (ClientData clientData)
437 free ( (void*) clientData);
441 * ir_obj_mk: IR Object creation
443 static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
444 int argc, char **argv)
450 interp->result = "wrong # args";
453 obj = malloc (sizeof(*obj));
456 interp->result = "malloc fail";
459 obj->cs_link = cs_create (tcpip_type);
461 obj->maximumMessageSize = 10000;
462 obj->preferredMessageSize = 4096;
464 obj->idAuthentication = NULL;
466 if (ir_strdup (interp, &obj->implementationName, "TCL/TK on YAZ")
470 if (ir_strdup (interp, &obj->implementationId, "TCL/TK/YAZ")
474 ODR_MASK_ZERO (&obj->protocolVersion);
475 ODR_MASK_SET (&obj->protocolVersion, 0);
476 ODR_MASK_SET (&obj->protocolVersion, 1);
478 ODR_MASK_ZERO (&obj->options);
479 ODR_MASK_SET (&obj->options, 0);
481 obj->odr_in = odr_createmem (ODR_DECODE);
482 obj->odr_out = odr_createmem (ODR_ENCODE);
483 obj->odr_pr = odr_createmem (ODR_PRINT);
485 obj->len_out = 10000;
486 obj->buf_out = malloc (obj->len_out);
489 interp->result = "malloc fail";
492 odr_setbuf (obj->odr_out, obj->buf_out, obj->len_out);
497 obj->callback = NULL;
499 Tcl_CreateCommand (interp, argv[1], ir_obj_method,
500 (ClientData) obj, ir_obj_delete);
504 /* ------------------------------------------------------- */
506 * do_query: Set query for a Set Object
508 static int do_query (void *obj, Tcl_Interp *interp,
509 int argc, char **argv)
516 * ir_set_obj_method: IR Set Object methods
518 static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
519 int argc, char **argv)
521 static IRMethod tab[] = {
522 { "query", do_query },
528 interp->result = "wrong # args";
531 return ir_method (clientData, interp, argc, argv, tab);
535 * ir_set_obj_delete: IR Set Object disposal
537 static void ir_set_obj_delete (ClientData clientData)
539 free ( (void*) clientData);
543 * ir_set_obj_mk: IR Set Object creation
545 static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
546 int argc, char **argv)
548 Tcl_CmdInfo parent_info;
553 interp->result = "wrong # args";
556 if (get_parent_info (interp, argv[1], &parent_info) == TCL_ERROR)
558 interp->result = "No parent";
561 obj = malloc (sizeof(*obj));
564 interp->result = "malloc fail";
567 obj->parent = (IRObj *) parent_info.clientData;
568 Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
569 (ClientData) obj, ir_set_obj_delete);
573 /* ------------------------------------------------------- */
575 static void ir_searchResponse (void *obj, Z_SearchResponse *searchrs)
577 if (searchrs->searchStatus)
578 printf("Search was a success.\n");
580 printf("Search was a bloomin' failure.\n");
581 printf("Number of hits: %d, setno %d\n",
582 *searchrs->resultCount, 1);
584 if (searchrs->records)
585 display_records(searchrs->records);
589 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
591 if (!*initrs->result)
592 printf("Connection rejected by target.\n");
594 printf("Connection accepted by target.\n");
595 if (initrs->implementationId)
596 printf("ID : %s\n", initrs->implementationId);
597 if (initrs->implementationName)
598 printf("Name : %s\n", initrs->implementationName);
599 if (initrs->implementationVersion)
600 printf("Version: %s\n", initrs->implementationVersion);
602 if (initrs->userInformationField)
604 printf("UserInformationfield:\n");
605 odr_external(&print, (Odr_external**)&initrs->
606 userInformationField, 0);
611 static void ir_presentResponse (void *obj, Z_PresentResponse *presrs)
613 printf("Received presentResponse.\n");
615 printf ("Got records\n");
617 printf("No records\n");
620 void ir_select_proc (ClientData clientData)
622 IRObj *p = clientData;
628 if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) < 0)
630 printf ("cs_get failed\n");
633 odr_setbuf (p->odr_in, p->buf_in, r);
634 printf ("cs_get ok, got %d\n", r);
635 if (!z_APDU (p->odr_in, &apdu, 0))
637 printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]);
642 Tcl_Eval (p->interp, p->callback);
646 case Z_APDU_initResponse:
647 ir_initResponse (NULL, apdu->u.initResponse);
649 case Z_APDU_searchResponse:
650 ir_searchResponse (NULL, apdu->u.searchResponse);
652 case Z_APDU_presentResponse:
653 ir_presentResponse (NULL, apdu->u.presentResponse);
656 printf("Received unknown APDU type (%d).\n",
659 } while (cs_more (p->cs_link));
662 /* ------------------------------------------------------- */
665 * ir_tcl_init: Registration of TCL commands.
667 int ir_tcl_init (Tcl_Interp *interp)
669 Tcl_CreateCommand (interp, "ir", ir_obj_mk, (ClientData) NULL,
670 (Tcl_CmdDeleteProc *) NULL);
671 Tcl_CreateCommand (interp, "ir-set", ir_set_obj_mk,
672 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);