+ * do_query: Set query for a Set Object
+ */
+static int do_query (void *obj, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ return TCL_OK;
+}
+
+
+/*
+ * ir_set_obj_method: IR Set Object methods
+ */
+static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ static IRMethod tab[] = {
+ { "query", do_query },
+ { NULL, NULL}
+ };
+
+ if (argc < 2)
+ {
+ interp->result = "wrong # args";
+ return TCL_ERROR;
+ }
+ return ir_method (clientData, interp, argc, argv, tab);
+}
+
+/*
+ * ir_set_obj_delete: IR Set Object disposal
+ */
+static void ir_set_obj_delete (ClientData clientData)
+{
+ free ( (void*) clientData);
+}
+
+/*
+ * ir_set_obj_mk: IR Set Object creation
+ */
+static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ Tcl_CmdInfo parent_info;
+ IRSetObj *obj;
+
+ if (argc != 2)
+ {
+ interp->result = "wrong # args";
+ return TCL_ERROR;
+ }
+ if (get_parent_info (interp, argv[1], &parent_info) == TCL_ERROR)
+ {
+ interp->result = "No parent";
+ return TCL_ERROR;
+ }
+ obj = malloc (sizeof(*obj));
+ if (!obj)
+ {
+ interp->result = "malloc fail";
+ return TCL_ERROR;
+ }
+ obj->parent = (IRObj *) parent_info.clientData;
+ Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
+ (ClientData) obj, ir_set_obj_delete);
+ return TCL_OK;
+}
+
+/* ------------------------------------------------------- */
+
+static void ir_searchResponse (void *obj, Z_SearchResponse *searchrs)
+{
+ if (searchrs->searchStatus)
+ printf("Search was a success.\n");
+ else
+ printf("Search was a bloomin' failure.\n");
+ printf("Number of hits: %d, setno %d\n",
+ *searchrs->resultCount, 1);
+#if 0
+ if (searchrs->records)
+ display_records(searchrs->records);
+#endif
+}
+
+static void ir_initResponse (void *obj, Z_InitResponse *initrs)
+{
+ if (!*initrs->result)
+ printf("Connection rejected by target.\n");
+ else
+ printf("Connection accepted by target.\n");
+ if (initrs->implementationId)
+ printf("ID : %s\n", initrs->implementationId);
+ if (initrs->implementationName)
+ printf("Name : %s\n", initrs->implementationName);
+ if (initrs->implementationVersion)
+ printf("Version: %s\n", initrs->implementationVersion);
+#if 0
+ if (initrs->userInformationField)
+ {
+ printf("UserInformationfield:\n");
+ odr_external(&print, (Odr_external**)&initrs->
+ userInformationField, 0);
+ }
+#endif
+}
+
+static void ir_presentResponse (void *obj, Z_PresentResponse *presrs)
+{
+ printf("Received presentResponse.\n");
+ if (presrs->records)
+ printf ("Got records\n");
+ else
+ printf("No records\n");
+}
+
+void ir_select_proc (ClientData clientData)
+{
+ IRObj *p = clientData;
+ Z_APDU *apdu;
+ int r;
+
+ do
+ {
+ if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) < 0)
+ {
+ printf ("cs_get failed\n");
+ return;
+ }
+ odr_setbuf (p->odr_in, p->buf_in, r);
+ printf ("cs_get ok, got %d\n", r);
+ if (!z_APDU (p->odr_in, &apdu, 0))
+ {
+ printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]);
+ return;
+ }
+ if (p->callback)
+ {
+ Tcl_Eval (p->interp, p->callback);
+ }
+ switch(apdu->which)
+ {
+ case Z_APDU_initResponse:
+ ir_initResponse (NULL, apdu->u.initResponse);
+ break;
+ case Z_APDU_searchResponse:
+ ir_searchResponse (NULL, apdu->u.searchResponse);
+ break;
+ case Z_APDU_presentResponse:
+ ir_presentResponse (NULL, apdu->u.presentResponse);
+ break;
+ default:
+ printf("Received unknown APDU type (%d).\n",
+ apdu->which);
+ }
+ } while (cs_more (p->cs_link));
+}
+
+/* ------------------------------------------------------- */
+
+/*
+ * ir_tcl_init: Registration of TCL commands.