* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.78 1996-02-21 10:16:08 adam
+ * Revision 1.80 1996-02-23 17:31:39 adam
+ * More functions made available to the wais tcl extension.
+ *
+ * Revision 1.79 1996/02/23 13:41:38 adam
+ * Work on public access to simple ir class system.
+ *
+ * Revision 1.78 1996/02/21 10:16:08 adam
* Simplified select handling. Only one function ir_tcl_select_set has
* to be externally defined.
*
#include "ir-tclp.h"
-typedef struct {
- int type;
- char *name;
- int (*method) (void *obj, Tcl_Interp *interp, int argc, char **argv);
-} IrTcl_Method;
-
-typedef struct {
- void *obj;
- IrTcl_Method *tab;
-} IrTcl_Methods;
-
static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
static int do_disconnect (void *obj, Tcl_Interp *interp,
int argc, char **argv);
}
/*
- * IrTcl_eval
+ * ir_tcl_eval
*/
-int IrTcl_eval (Tcl_Interp *interp, const char *command)
+int ir_tcl_eval (Tcl_Interp *interp, const char *command)
{
char *tmp = ir_tcl_malloc (strlen(command)+1);
int r;
}
/*
- * ir_method: Search for method in table and invoke method handler
+ * ir_tcl_method: Search for method in table and invoke method handler
*/
-int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
+int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
{
IrTcl_Methods *tab_i = tab;
IrTcl_Method *t;
if (argc <= 0)
return TCL_OK;
+#if 0
Tcl_AppendResult (interp, "Bad method: ", argv[1],
". Possible methods:", NULL);
for (tab_i = tab; tab_i->tab; tab_i++)
for (t = tab_i->tab; t->name; t++)
Tcl_AppendResult (interp, " ", t->name, NULL);
+#endif
return TCL_ERROR;
}
/*
- * ir_method_r: Get status for all readable elements
- */
-int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv,
- IrTcl_Method *tab)
-{
- char *argv_n[3];
- int argc_n;
-
- argv_n[0] = argv[0];
- argc_n = 2;
- for (; tab->name; tab++)
- if (tab->type)
- {
- argv_n[1] = tab->name;
- Tcl_AppendResult (interp, "{", NULL);
- (*tab->method)(obj, interp, argc_n, argv_n);
- Tcl_AppendResult (interp, "} ", NULL);
- }
- return TCL_OK;
-}
-
-/*
* ir_named_bits: get/set named bits
*/
int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
{
p->state = IR_TCL_R_Idle;
if (p->callback)
- IrTcl_eval (p->interp, p->callback);
+ ir_tcl_eval (p->interp, p->callback);
}
}
else
}
static IrTcl_Method ir_method_tab[] = {
-{ 1, "comstack", do_comstack },
-{ 1, "protocol", do_protocol },
-{ 0, "failback", do_failback },
-{ 0, "failInfo", do_failInfo },
-{ 0, "apduInfo", do_apduInfo },
-{ 0, "logLevel", do_logLevel },
-
-{ 0, "eventType", do_eventType },
-{ 1, "connect", do_connect },
-{ 0, "protocolVersion", do_protocolVersion },
-{ 1, "preferredMessageSize", do_preferredMessageSize },
-{ 1, "maximumRecordSize", do_maximumRecordSize },
-{ 1, "implementationName", do_implementationName },
-{ 1, "implementationId", do_implementationId },
-{ 1, "implementationVersion", do_implementationVersion },
-{ 0, "targetImplementationName", do_targetImplementationName },
-{ 0, "targetImplementationId", do_targetImplementationId },
-{ 0, "targetImplementationVersion", do_targetImplementationVersion },
-{ 0, "userInformationField", do_userInformationField },
-{ 1, "idAuthentication", do_idAuthentication },
-{ 0, "options", do_options },
-{ 0, "init", do_init_request },
-{ 0, "initResult", do_initResult },
-{ 0, "disconnect", do_disconnect },
-{ 0, "callback", do_callback },
-{ 0, "initResponse", do_initResponse },
-{ 0, "triggerResourceControl", do_triggerResourceControl },
-{ 0, "initResponse", do_initResponse },
-{ 0, NULL, NULL}
+{ "comstack", do_comstack, NULL },
+{ "protocol", do_protocol, NULL },
+{ "failback", do_failback, NULL },
+{ "failInfo", do_failInfo, NULL },
+{ "apduInfo", do_apduInfo, NULL },
+{ "logLevel", do_logLevel, NULL },
+
+{ "eventType", do_eventType, NULL },
+{ "connect", do_connect, NULL },
+{ "protocolVersion", do_protocolVersion, NULL },
+{ "preferredMessageSize", do_preferredMessageSize, NULL },
+{ "maximumRecordSize", do_maximumRecordSize, NULL },
+{ "implementationName", do_implementationName, NULL },
+{ "implementationId", do_implementationId, NULL },
+{ "implementationVersion", do_implementationVersion, NULL },
+{ "targetImplementationName", do_targetImplementationName, NULL },
+{ "targetImplementationId", do_targetImplementationId, NULL },
+{ "targetImplementationVersion", do_targetImplementationVersion, NULL},
+{ "userInformationField", do_userInformationField, NULL},
+{ "idAuthentication", do_idAuthentication, NULL},
+{ "options", do_options, NULL},
+{ "init", do_init_request, NULL},
+{ "initResult", do_initResult, NULL},
+{ "disconnect", do_disconnect, NULL},
+{ "callback", do_callback, NULL},
+{ "initResponse", do_initResponse, NULL},
+{ "triggerResourceControl", do_triggerResourceControl, NULL},
+{ "initResponse", do_initResponse, NULL},
+{ NULL, NULL}
};
static IrTcl_Method ir_set_c_method_tab[] = {
-{ 0, "databaseNames", do_databaseNames},
-{ 0, "replaceIndicator", do_replaceIndicator},
-{ 0, "queryType", do_queryType },
-{ 0, "preferredRecordSyntax", do_preferredRecordSyntax },
-{ 0, "smallSetUpperBound", do_smallSetUpperBound},
-{ 0, "largeSetLowerBound", do_largeSetLowerBound},
-{ 0, "mediumSetPresentNumber", do_mediumSetPresentNumber},
-{ 0, "referenceId", do_referenceId },
-{ 0, "elementSetNames", do_elementSetNames },
-{ 0, "smallSetElementSetNames", do_smallSetElementSetNames },
-{ 0, "mediumSetElementSetNames", do_mediumSetElementSetNames },
-{ 0, NULL, NULL}
+{ "databaseNames", do_databaseNames, NULL},
+{ "replaceIndicator", do_replaceIndicator, NULL},
+{ "queryType", do_queryType, NULL},
+{ "preferredRecordSyntax", do_preferredRecordSyntax, NULL},
+{ "smallSetUpperBound", do_smallSetUpperBound, NULL},
+{ "largeSetLowerBound", do_largeSetLowerBound, NULL},
+{ "mediumSetPresentNumber", do_mediumSetPresentNumber, NULL},
+{ "referenceId", do_referenceId, NULL},
+{ "elementSetNames", do_elementSetNames, NULL},
+{ "smallSetElementSetNames", do_smallSetElementSetNames, NULL},
+{ "mediumSetElementSetNames", do_mediumSetElementSetNames, NULL},
+{ NULL, NULL}
};
/*
IrTcl_Obj *p = clientData;
if (argc < 2)
- return ir_method_r (clientData, interp, argc, argv, ir_method_tab);
-
+ return TCL_ERROR;
+
tab[0].tab = ir_method_tab;
tab[0].obj = p;
tab[1].tab = ir_set_c_method_tab;
tab[1].obj = &p->set_inher;
tab[2].tab = NULL;
-
- return ir_method (interp, argc, argv, tab);
+
+ return ir_tcl_method (interp, argc, argv, tab);
}
/*
tab[1].obj = &obj->set_inher;
tab[2].tab = NULL;
- ir_method (NULL, -1, NULL, tab);
+ ir_tcl_method (NULL, -1, NULL, tab);
ir_tcl_del_q (obj);
odr_destroy (obj->odr_in);
}
/*
- * ir_obj_mk: IR Object creation
+ * ir_obj_init: IR Object initialization
*/
-static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv)
+int ir_obj_init (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv, ClientData *subData)
{
IrTcl_Methods tab[3];
IrTcl_Obj *obj;
tab[1].obj = &obj->set_inher;
tab[2].tab = NULL;
- if (ir_method (interp, 0, NULL, tab) == TCL_ERROR)
+ if (ir_tcl_method (interp, 0, NULL, tab) == TCL_ERROR)
+ {
+ Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
+ return TCL_ERROR;
+ }
+ *subData = obj;
+ return TCL_OK;
+}
+
+
+/*
+ * ir_obj_mk: IR Object creation
+ */
+static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ ClientData subData;
+ int r = ir_obj_init (clientData, interp, argc, argv, &subData);
+
+ if (r == TCL_ERROR)
return TCL_ERROR;
Tcl_CreateCommand (interp, argv[1], ir_obj_method,
- (ClientData) obj, ir_obj_delete);
+ subData, ir_obj_delete);
return TCL_OK;
}
+IrTcl_Class ir_obj_class = {
+ "ir",
+ ir_obj_init,
+ ir_obj_method,
+ ir_obj_delete
+};
+
+
/* ------------------------------------------------------- */
/*
* do_search: Do search request
}
static IrTcl_Method ir_set_method_tab[] = {
- { 0, "search", do_search },
- { 0, "searchResponse", do_searchResponse },
- { 0, "presentResponse", do_presentResponse },
- { 0, "searchStatus", do_searchStatus },
- { 0, "presentStatus", do_presentStatus },
- { 0, "nextResultSetPosition", do_nextResultSetPosition },
- { 0, "setName", do_setName },
- { 0, "resultCount", do_resultCount },
- { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
- { 0, "present", do_present },
- { 0, "type", do_type },
- { 0, "getMarc", do_getMarc },
- { 0, "getSutrs", do_getSutrs },
- { 0, "getGrs", do_getGrs },
- { 0, "recordType", do_recordType },
- { 0, "recordElements", do_recordElements },
- { 0, "diag", do_diag },
- { 0, "responseStatus", do_responseStatus },
- { 0, "loadFile", do_loadFile },
- { 0, NULL, NULL}
+ { "search", do_search, NULL},
+ { "searchResponse", do_searchResponse, NULL},
+ { "presentResponse", do_presentResponse, NULL},
+ { "searchStatus", do_searchStatus, NULL},
+ { "presentStatus", do_presentStatus, NULL},
+ { "nextResultSetPosition", do_nextResultSetPosition, NULL},
+ { "setName", do_setName, NULL},
+ { "resultCount", do_resultCount, NULL},
+ { "numberOfRecordsReturned", do_numberOfRecordsReturned, NULL},
+ { "present", do_present, NULL},
+ { "type", do_type, NULL},
+ { "getMarc", do_getMarc, NULL},
+ { "getSutrs", do_getSutrs, NULL},
+ { "getGrs", do_getGrs, NULL},
+ { "recordType", do_recordType, NULL},
+ { "recordElements", do_recordElements, NULL},
+ { "diag", do_diag, NULL},
+ { "responseStatus", do_responseStatus, NULL},
+ { "loadFile", do_loadFile, NULL},
+ { NULL, NULL}
};
/*
tabs[1].obj = &p->set_inher;
tabs[2].tab = NULL;
- return ir_method (interp, argc, argv, tabs);
+ return ir_tcl_method (interp, argc, argv, tabs);
}
/*
tabs[1].obj = &p->set_inher;
tabs[2].tab = NULL;
- ir_method (NULL, -1, NULL, tabs);
+ ir_tcl_method (NULL, -1, NULL, tabs);
free (p);
}
tabs[0].obj = obj;
tabs[1].tab = NULL;
- if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR)
+ if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR)
return TCL_ERROR;
Tcl_CreateCommand (interp, argv[1], ir_set_obj_method,
}
static IrTcl_Method ir_scan_method_tab[] = {
- { 0, "scan", do_scan },
- { 0, "scanResponse", do_scanResponse },
- { 0, "stepSize", do_stepSize },
- { 0, "numberOfTermsRequested", do_numberOfTermsRequested },
- { 0, "preferredPositionInResponse", do_preferredPositionInResponse },
- { 0, "scanStatus", do_scanStatus },
- { 0, "numberOfEntriesReturned", do_numberOfEntriesReturned },
- { 0, "positionOfTerm", do_positionOfTerm },
- { 0, "scanLine", do_scanLine },
- { 0, NULL, NULL}
+ { "scan", do_scan, NULL},
+ { "scanResponse", do_scanResponse, NULL},
+ { "stepSize", do_stepSize, NULL},
+ { "numberOfTermsRequested", do_numberOfTermsRequested, NULL},
+ { "preferredPositionInResponse", do_preferredPositionInResponse, NULL},
+ { "scanStatus", do_scanStatus, NULL},
+ { "numberOfEntriesReturned", do_numberOfEntriesReturned, NULL},
+ { "positionOfTerm", do_positionOfTerm, NULL},
+ { "scanLine", do_scanLine, NULL},
+ { NULL, NULL}
};
/*
tabs[0].obj = clientData;
tabs[1].tab = NULL;
- return ir_method (interp, argc, argv, tabs);
+ return ir_tcl_method (interp, argc, argv, tabs);
}
/*
tabs[0].obj = obj;
tabs[1].tab = NULL;
- ir_method (NULL, -1, NULL, tabs);
+ ir_tcl_method (NULL, -1, NULL, tabs);
free (obj);
}
tabs[0].obj = obj;
tabs[1].tab = NULL;
- if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR)
+ if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR)
return TCL_ERROR;
Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method,
(ClientData) obj, ir_scan_obj_delete);
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_CONNECT;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
do_disconnect (p, NULL, 2, NULL);
return;
}
p->state = IR_TCL_R_Idle;
if (p->callback)
- IrTcl_eval (p->interp, p->callback);
+ ir_tcl_eval (p->interp, p->callback);
if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
ir_tcl_send_q (p, p->request_queue, "x");
return;
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_READ;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
/* release ir object now if callback deleted it */
ir_obj_delete (p);
{
p->failInfo = IR_TCL_FAIL_IN_APDU;
p->apduOffset = odr_offset (p->odr_in);
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
/* release ir object now if failback deleted it */
ir_obj_delete (p);
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
return;
}
p->state = IR_TCL_R_Idle;
if (apdu_call)
- IrTcl_eval (p->interp, apdu_call);
+ ir_tcl_eval (p->interp, apdu_call);
else if (rq->callback)
- IrTcl_eval (p->interp, rq->callback);
+ ir_tcl_eval (p->interp, rq->callback);
free (rq->buf_out);
free (rq->callback);
free (rq->object_name);
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_CONNECT;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
do_disconnect (p, NULL, 2, NULL);
return;
ir_select_remove_write (cs_fileno (p->cs_link), p);
#endif
if (p->callback)
- IrTcl_eval (p->interp, p->callback);
+ ir_tcl_eval (p->interp, p->callback);
return;
}
rq = p->request_queue;
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_WRITE;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
free (rq->buf_out);
rq->buf_out = NULL;
projects / ir-tcl-moved-to-github.git / blobdiff