/*
* IR toolkit for tcl/tk
- * (c) Index Data 1995
+ * (c) Index Data 1995-1996
* See the file LICENSE for details.
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.84 1996-03-07 12:42:49 adam
+ * Revision 1.93 1996-08-16 15:07:45 adam
+ * First work on Explain.
+ *
+ * Revision 1.92 1996/08/09 15:33:07 adam
+ * Modified the code to use tk4.1/tcl7.5 patch level 1. The time-driven
+ * polling is no longer activated on Windows since asynchrounous I/O works
+ * better.
+ *
+ * Revision 1.91 1996/07/03 13:31:11 adam
+ * The xmalloc/xfree functions from YAZ are used to manage memory.
+ *
+ * Revision 1.90 1996/06/27 14:21:00 adam
+ * Yet another Windows port.
+ *
+ * Revision 1.89 1996/06/11 15:27:15 adam
+ * Event type set to connect a little earlier in the do_connect function.
+ *
+ * Revision 1.88 1996/06/03 09:04:22 adam
+ * Changed a few logf calls.
+ *
+ * Revision 1.87 1996/05/29 06:37:51 adam
+ * Function ir_tcl_get_grs_r enhanced so that specific elements can be
+ * extracted.
+ *
+ * Revision 1.86 1996/03/20 13:54:04 adam
+ * The Tcl_File structure is only manipulated in the Tk-event interface
+ * in tkinit.c.
+ *
+ * Revision 1.85 1996/03/15 11:15:48 adam
+ * Modified to use new prototypes for p_query_rpn and p_query_scan.
+ *
+ * Revision 1.84 1996/03/07 12:42:49 adam
* Better logging when callback is invoked.
*
* Revision 1.83 1996/03/05 09:21:09 adam
#include <stdlib.h>
#include <stdio.h>
+#ifdef WINDOWS
+
+#else
#include <unistd.h>
+#endif
#include <time.h>
#include <assert.h>
#define CS_BLOCK 0
-#define IRTCL_GENERIC_FILES 0
-
#include "ir-tclp.h"
static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
default:
break;
}
- free (rl->u.dbrec.buf);
+ xfree (rl->u.dbrec.buf);
+ rl->u.dbrec.buf = NULL;
break;
case Z_NamePlusRecord_surrogateDiagnostic:
ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
&rl->u.surrogateDiagnostics.num);
break;
}
- free (rl->elements);
+ xfree (rl->elements);
}
static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj,
strcpy (tmp, command);
r = Tcl_Eval (interp, tmp);
if (r == TCL_ERROR)
+ {
logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine,
interp->result);
+ }
Tcl_FreeResult (interp);
- free (tmp);
+ xfree (tmp);
return r;
}
{
delete_IR_record (rl);
rl1 = rl->next;
- free (rl);
+ xfree (rl);
}
setobj->record_list = NULL;
}
static void get_referenceId (char **dst, Z_ReferenceId *src)
{
- free (*dst);
+ xfree (*dst);
if (!src)
{
*dst = NULL;
if (argc <= 0)
return TCL_OK;
+ logf (LOG_DEBUG, "init %s", *argv);
if (!p->cs_link)
{
interp->result = "init: not connected";
return ir_tcl_strdel (interp, &p->implementationName);
if (argc == 3)
{
- free (p->implementationName);
+ xfree (p->implementationName);
if (ir_tcl_strdup (interp, &p->implementationName, argv[2])
== TCL_ERROR)
return TCL_ERROR;
if (argc == 0)
return ir_tcl_strdup (interp, &p->implementationVersion,
- "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
+ "YAZ: " YAZ_VERSION
+#ifdef IR_TCL_VERSION
+ " / Irtcl: " IR_TCL_VERSION
+#endif
+ );
else if (argc == -1)
return ir_tcl_strdel (interp, &p->implementationVersion);
Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
if (argc >= 3 || argc == -1)
{
- free (p->idAuthenticationOpen);
- free (p->idAuthenticationGroupId);
- free (p->idAuthenticationUserId);
- free (p->idAuthenticationPassword);
+ xfree (p->idAuthenticationOpen);
+ xfree (p->idAuthenticationGroupId);
+ xfree (p->idAuthenticationUserId);
+ xfree (p->idAuthenticationPassword);
}
if (argc >= 3 || argc <= 0)
{
return TCL_OK;
if (argc == 3)
{
+ logf (LOG_DEBUG, "connect %s %s", *argv, argv[2]);
if (p->hostname)
{
interp->result = "already connected";
}
if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
return TCL_ERROR;
-#if IRTCL_GENERIC_FILES
-#ifdef WINDOWS
- p->csFile = Tcl_GetFile (cs_fileno(p->cs_link), TCL_WIN_SOCKET);
-#else
- p->csFile = Tcl_GetFile (cs_fileno(p->cs_link), TCL_UNIX_FD);
-#endif
-#endif
+ p->eventType = "connect";
if ((r=cs_connect (p->cs_link, addr)) < 0)
{
interp->result = "connect fail";
ir_tcl_disconnect (p);
return TCL_ERROR;
}
- logf(LOG_DEBUG, "cs_connect() returned %d fd=%d", r,
- cs_fileno(p->cs_link));
- p->eventType = "connect";
-#if IRTCL_GENERIC_FILES
- ir_select_add (p->csFile, p);
-#else
ir_select_add (cs_fileno (p->cs_link), p);
-#endif
if (r == 1)
{
-#if IRTCL_GENERIC_FILES
- ir_select_add_write (p->csFile, p);
-#else
+ logf (LOG_DEBUG, "connect pending fd=%d", cs_fileno(p->cs_link));
ir_select_add_write (cs_fileno (p->cs_link), p);
-#endif
p->state = IR_TCL_R_Connecting;
}
else
{
+ logf (LOG_DEBUG, "connect ok fd=%d", cs_fileno(p->cs_link));
p->state = IR_TCL_R_Idle;
if (p->callback)
ir_tcl_eval (p->interp, p->callback);
{
if (p->hostname)
{
- logf(LOG_DEBUG, "Closing connection to %s", p->hostname);
- free (p->hostname);
+ logf(LOG_DEBUG, "Closing connection to %s", p->hostname);
+ xfree (p->hostname);
p->hostname = NULL;
-#if IRTCL_GENERIC_FILES
- ir_select_remove_write (p->csFile, p);
- ir_select_remove (p->csFile, p);
-#else
ir_select_remove_write (cs_fileno (p->cs_link), p);
ir_select_remove (cs_fileno (p->cs_link), p);
-#endif
odr_reset (p->odr_in);
assert (p->cs_link);
cs_close (p->cs_link);
p->cs_link = NULL;
-#if IRTCL_GENERIC_FILES
- Tcl_FreeFile (p->csFile);
- p->csFile = NULL;
-#endif
ODR_MASK_ZERO (&p->options);
ODR_MASK_SET (&p->options, 0);
p->eventType = NULL;
p->hostname = NULL;
p->cs_link = NULL;
-#if IRTCL_GENERIC_FILES
- p->csFile = 0;
-#endif
return TCL_OK;
}
ir_tcl_disconnect (p);
return ir_tcl_strdel (interp, &obj->comstackType);
else if (argc == 3)
{
- free (obj->comstackType);
+ xfree (obj->comstackType);
if (ir_tcl_strdup (interp, &obj->comstackType, argv[2]) == TCL_ERROR)
return TCL_ERROR;
}
return ir_tcl_strdel (interp, &p->callback);
if (argc == 3)
{
- free (p->callback);
+ xfree (p->callback);
if (argv[2][0])
{
if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
return ir_tcl_strdel (interp, &p->failback);
else if (argc == 3)
{
- free (p->failback);
+ xfree (p->failback);
if (argv[2][0])
{
if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
return ir_tcl_strdel (interp, &p->initResponse);
if (argc == 3)
{
- free (p->initResponse);
+ xfree (p->initResponse);
if (argv[2][0])
{
if (ir_tcl_strdup (interp, &p->initResponse, argv[2]) == TCL_ERROR)
if (argc == -1)
{
for (i=0; i<p->num_databaseNames; i++)
- free (p->databaseNames[i]);
- free (p->databaseNames);
+ xfree (p->databaseNames[i]);
+ xfree (p->databaseNames);
}
if (argc <= 0)
{
if (p->databaseNames)
{
for (i=0; i<p->num_databaseNames; i++)
- free (p->databaseNames[i]);
- free (p->databaseNames);
+ xfree (p->databaseNames[i]);
+ xfree (p->databaseNames);
}
p->num_databaseNames = argc - 2;
p->databaseNames =
return ir_tcl_strdel (interp, &p->queryType);
if (argc == 3)
{
- free (p->queryType);
+ xfree (p->queryType);
if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR)
return TCL_ERROR;
}
return ir_tcl_strdel (interp, &p->referenceId);
if (argc == 3)
{
- free (p->referenceId);
+ xfree (p->referenceId);
if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR)
return TCL_ERROR;
}
}
else if (argc == -1)
{
- free (p->preferredRecordSyntax);
+ xfree (p->preferredRecordSyntax);
p->preferredRecordSyntax = NULL;
return TCL_OK;
}
if (argc == 3)
{
- free (p->preferredRecordSyntax);
+ xfree (p->preferredRecordSyntax);
p->preferredRecordSyntax = NULL;
if (argv[2][0] && (p->preferredRecordSyntax =
ir_tcl_malloc (sizeof(*p->preferredRecordSyntax))))
}
else if (argc == 2)
{
- Tcl_AppendElement (interp, IrTcl_getRecordSyntaxStr
- (*p->preferredRecordSyntax));
+ Tcl_AppendElement
+ (interp,!p->preferredRecordSyntax ? "" :
+ IrTcl_getRecordSyntaxStr(*p->preferredRecordSyntax));
}
return TCL_OK;
return ir_tcl_strdel (interp, &p->elementSetNames);
if (argc == 3)
{
- free (p->elementSetNames);
+ xfree (p->elementSetNames);
if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR)
return TCL_ERROR;
}
return ir_tcl_strdel (interp, &p->smallSetElementSetNames);
if (argc == 3)
{
- free (p->smallSetElementSetNames);
+ xfree (p->smallSetElementSetNames);
if (ir_tcl_strdup (interp, &p->smallSetElementSetNames,
argv[2]) == TCL_ERROR)
return TCL_ERROR;
return ir_tcl_strdel (interp, &p->mediumSetElementSetNames);
if (argc == 3)
{
- free (p->mediumSetElementSetNames);
+ xfree (p->mediumSetElementSetNames);
if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames,
argv[2]) == TCL_ERROR)
return TCL_ERROR;
odr_destroy (obj->odr_in);
odr_destroy (obj->odr_out);
odr_destroy (obj->odr_pr);
- free (obj);
+ xfree (obj);
}
/*
IrTcl_SetObj *obj = o;
IrTcl_Obj *p;
int r;
- oident bib1;
if (argc <= 0)
return TCL_OK;
p = obj->parent;
if (argc != 3)
{
+ logf (LOG_DEBUG, "search %s", *argv);
interp->result = "wrong # args";
return TCL_ERROR;
}
+ logf (LOG_DEBUG, "search %s %s", *argv, argv[2]);
if (!obj->set_inher.num_databaseNames)
{
interp->result = "no databaseNames";
obj->start = 1;
- bib1.proto = p->protocol_type;
- bib1.oclass = CLASS_ATTSET;
- bib1.value = VAL_BIB1;
-
set_referenceId (p->odr_out, &req->referenceId,
obj->set_inher.referenceId);
req->mediumSetElementSetNames = NULL;
req->query = &query;
-
+
+ logf (LOG_DEBUG, "queryType %s", obj->set_inher.queryType);
if (!strcmp (obj->set_inher.queryType, "rpn"))
{
Z_RPNQuery *RPNquery;
- RPNquery = p_query_rpn (p->odr_out, argv[2]);
+ RPNquery = p_query_rpn (p->odr_out, p->protocol_type, argv[2]);
if (!RPNquery)
{
Tcl_AppendResult (interp, "Syntax error in query", NULL);
return TCL_ERROR;
}
- RPNquery->attributeSetId = oid_getoidbyent (&bib1);
query.which = Z_Query_type_1;
query.u.type_1 = RPNquery;
- logf (LOG_DEBUG, "RPN");
}
#if CCL2RPN
else if (!strcmp (obj->set_inher.queryType, "cclrpn"))
int pos;
struct ccl_rpn_node *rpn;
Z_RPNQuery *RPNquery;
+ oident bib1;
+
+ bib1.proto = p->protocol_type;
+ bib1.oclass = CLASS_ATTSET;
+ bib1.value = VAL_BIB1;
rpn = ccl_find_str(p->bibset, argv[2], &error, &pos);
if (error)
ccl_err_msg(error), NULL);
return TCL_ERROR;
}
+#if 0
ccl_pr_tree (rpn, stderr);
fprintf (stderr, "\n");
+#endif
assert((RPNquery = ccl_rpn_query(rpn)));
RPNquery->attributeSetId = oid_getoidbyent (&bib1);
query.which = Z_Query_type_1;
query.u.type_1 = RPNquery;
- logf (LOG_DEBUG, "CCLRPN");
}
#endif
else if (!strcmp (obj->set_inher.queryType, "ccl"))
query.u.type_2 = &ccl_query;
ccl_query.buf = (unsigned char *) argv[2];
ccl_query.len = strlen (argv[2]);
- logf (LOG_DEBUG, "CCL");
}
else
{
return ir_tcl_strdel (interp, &obj->searchResponse);
if (argc == 3)
{
- free (obj->searchResponse);
+ xfree (obj->searchResponse);
if (argv[2][0])
{
if (ir_tcl_strdup (interp, &obj->searchResponse, argv[2])
return ir_tcl_strdel (interp, &obj->presentResponse);
if (argc == 3)
{
- free (obj->presentResponse);
+ xfree (obj->presentResponse);
if (argv[2][0])
{
if (ir_tcl_strdup (interp, &obj->presentResponse, argv[2])
return ir_tcl_strdel (interp, &obj->setName);
if (argc == 3)
{
- free (obj->setName);
+ xfree (obj->setName);
if (ir_tcl_strdup (interp, &obj->setName, argv[2])
== TCL_ERROR)
return TCL_ERROR;
}
if (argc == 3)
{
- free (obj->recordElements);
+ xfree (obj->recordElements);
return ir_tcl_strdup (NULL, &obj->recordElements,
(*argv[2] ? argv[2] : NULL));
}
for (i = 0; i<num; i++)
{
- logf (LOG_DEBUG, "Diagnostic, code %d", list[i].condition);
sprintf (buf, "%d", list[i].condition);
Tcl_AppendElement (interp, buf);
cp = diagbib1_str (list[i].condition);
/*
- * do_getGrs: Get a GRS1 Record
+ * do_getGrs: Get a GRS-1 Record
*/
static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
{
/*
+ * do_getExplain: Get an Explain Record
+ */
+static int do_getExplain (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+ IrTcl_SetObj *obj = o;
+ IrTcl_Obj *p = obj->parent;
+ void *rr;
+ Z_ext_typeent *etype;
+ int offset;
+ IrTcl_RecordList *rl;
+
+ if (argc <= 0)
+ return TCL_OK;
+ if (argc < 3)
+ {
+ sprintf (interp->result, "wrong # args");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
+ return TCL_ERROR;
+ rl = find_IR_record (obj, offset);
+ if (!rl)
+ {
+ Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
+ return TCL_ERROR;
+ }
+ if (rl->which != Z_NamePlusRecord_databaseRecord)
+ {
+ Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
+ return TCL_ERROR;
+ }
+ if (rl->u.dbrec.type != VAL_EXPLAIN)
+ return TCL_OK;
+
+ if (!(etype = z_ext_getentbyref (VAL_EXPLAIN)))
+ return TCL_OK;
+
+ odr_setbuf (p->odr_in, rl->u.dbrec.buf, rl->u.dbrec.size, 0);
+ if (!(*etype->fun)(p->odr_in, &rr, 0))
+ return TCL_OK;
+
+ if (etype->what != Z_External_explainRecord)
+ return TCL_OK;
+
+ return ir_tcl_get_explain (interp, rr, argc, argv);
+}
+
+/*
* do_responseStatus: Return response status (present or search)
*/
static int do_responseStatus (void *o, Tcl_Interp *interp,
}
else
number = 10;
+ logf (LOG_DEBUG, "present %s %d %d", *argv, start, number);
p = obj->parent;
if (!p->cs_link)
{
{ "getMarc", do_getMarc, NULL},
{ "getSutrs", do_getSutrs, NULL},
{ "getGrs", do_getGrs, NULL},
+ { "getExplain", do_getExplain, NULL},
{ "recordType", do_recordType, NULL},
{ "recordElements", do_recordElements, NULL},
{ "diag", do_diag, NULL},
ir_tcl_method (NULL, -1, NULL, tabs, NULL);
- free (p);
+ xfree (p);
}
/*
return TCL_ERROR;
}
obj = ir_tcl_malloc (sizeof(*obj));
- logf (LOG_DEBUG, "ir set create");
+ logf (LOG_DEBUG, "ir set create %s", argv[1]);
if (parentData)
{
int i;
Z_APDU *apdu;
IrTcl_ScanObj *obj = o;
IrTcl_Obj *p = obj->parent;
- oident bib1;
#if CCL2RPN
+ oident bib1;
struct ccl_rpn_node *rpn;
int pos;
#endif
interp->result = "wrong # args";
return TCL_ERROR;
}
+ logf (LOG_DEBUG, "scan %s %s", *argv, argv[2]);
if (!p->set_inher.num_databaseNames)
{
interp->result = "no databaseNames";
return TCL_ERROR;
}
- bib1.proto = p->protocol_type;
- bib1.oclass = CLASS_ATTSET;
- bib1.value = VAL_BIB1;
-
apdu = zget_APDU (p->odr_out, Z_APDU_scanRequest);
req = apdu->u.scanRequest;
set_referenceId (p->odr_out, &req->referenceId, p->set_inher.referenceId);
req->num_databaseNames = p->set_inher.num_databaseNames;
req->databaseNames = p->set_inher.databaseNames;
- req->attributeSet = oid_getoidbyent (&bib1);
#if !CCL2RPN
- if (!(req->termListAndStartPoint = p_query_scan (p->odr_out, argv[2])))
+ if (!(req->termListAndStartPoint =
+ p_query_scan (p->odr_out, p->protocol_type,
+ &req->attributeSet, argv[2])))
{
Tcl_AppendResult (interp, "Syntax error in query", NULL);
return TCL_ERROR;
Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg (r), NULL);
return TCL_ERROR;
}
- ccl_pr_tree (rpn, stderr);
- fprintf (stderr, "\n");
+ bib1.proto = p->protocol_type;
+ bib1.oclass = CLASS_ATTSET;
+ bib1.value = VAL_BIB1;
+
+ req->attributeSet = oid_getoidbyent (&bib1);
if (!(req->termListAndStartPoint = ccl_scan_query (rpn)))
return TCL_ERROR;
#endif
return ir_tcl_strdel (interp, &obj->scanResponse);
if (argc == 3)
{
- free (obj->scanResponse);
+ xfree (obj->scanResponse);
if (argv[2][0])
{
if (ir_tcl_strdup (interp, &obj->scanResponse, argv[2])
tabs[1].tab = NULL;
ir_tcl_method (NULL, -1, NULL, tabs, NULL);
- free (obj);
+ xfree (obj);
}
/*
interp->result = "wrong # args";
return TCL_ERROR;
}
+ logf (LOG_DEBUG, "ir scan create %s", argv[1]);
if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
{
interp->result = "No parent";
get_referenceId (&p->set_inher.referenceId, initrs->referenceId);
- free (p->targetImplementationId);
+ xfree (p->targetImplementationId);
ir_tcl_strdup (p->interp, &p->targetImplementationId,
initrs->implementationId);
- free (p->targetImplementationName);
+ xfree (p->targetImplementationName);
ir_tcl_strdup (p->interp, &p->targetImplementationName,
initrs->implementationName);
- free (p->targetImplementationVersion);
+ xfree (p->targetImplementationVersion);
ir_tcl_strdup (p->interp, &p->targetImplementationVersion,
initrs->implementationVersion);
memcpy (&p->options, initrs->options, sizeof(initrs->options));
memcpy (&p->protocolVersion, initrs->protocolVersion,
sizeof(initrs->protocolVersion));
- free (p->userInformationField);
+ xfree (p->userInformationField);
p->userInformationField = NULL;
if (initrs->userInformationField)
{
{
int i;
for (i = 0; i<*dst_num; i++)
- free (dst_list[i]->addinfo);
- free (*dst_list);
+ xfree (dst_list[i]->addinfo);
+ xfree (*dst_list);
*dst_list = NULL;
*dst_num = 0;
}
static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
- Z_DiagRec **list, int num)
+ Z_DiagRec **list, int num)
{
int i;
char *addinfo;
*dst_list = ir_tcl_malloc (sizeof(**dst_list) * num);
for (i = 0; i<num; i++)
{
+ const char *cp;
switch (list[i]->which)
{
case Z_DiagRec_defaultFormat:
if (addinfo &&
((*dst_list)[i].addinfo = ir_tcl_malloc (strlen(addinfo)+1)))
strcpy ((*dst_list)[i].addinfo, addinfo);
+ cp = diagbib1_str ((*dst_list)[i].condition);
+ logf (LOG_DEBUG, "Diag %d %s %s", (*dst_list)[i].condition,
+ cp ? cp : "", addinfo ? addinfo : "");
break;
default:
(*dst_list)[i].addinfo = NULL;
}
}
-static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
+static void ir_handleDBRecord (IrTcl_Obj *p, IrTcl_RecordList *rl,
+ Z_External *oe)
+{
+ struct oident *ident;
+ Z_ext_typeent *etype;
+
+ rl->u.dbrec.size = oe->u.octet_aligned->len;
+ rl->u.dbrec.buf = NULL;
+
+ if ((ident = oid_getentbyoid (oe->direct_reference)))
+ rl->u.dbrec.type = ident->value;
+ else
+ rl->u.dbrec.type = VAL_USMARC;
+
+ if (ident && (oe->which == Z_External_single ||
+ oe->which == Z_External_octet)
+ && (etype = z_ext_getentbyref (ident->value)))
+ {
+ void *rr;
+
+ odr_setbuf (p->odr_in, (char*) oe->u.octet_aligned->buf,
+ oe->u.octet_aligned->len, 0);
+ if (!(*etype->fun)(p->odr_in, &rr, 0))
+ return;
+ switch (etype->what)
+ {
+ case Z_External_sutrs:
+ logf (LOG_LOG, "Z_External_sutrs");
+ oe->u.sutrs = rr;
+ if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
+ {
+ memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
+ oe->u.sutrs->len);
+ rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
+ }
+ rl->u.dbrec.size = oe->u.sutrs->len;
+ break;
+ case Z_External_grs1:
+ logf (LOG_LOG, "Z_External_grs1");
+ oe->u.grs1 = rr;
+ ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
+ break;
+ case Z_External_explainRecord:
+ logf (LOG_LOG, "Z_External_explainRecord");
+ if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
+ {
+ memcpy (rl->u.dbrec.buf, oe->u.octet_aligned->buf,
+ rl->u.dbrec.size);
+ }
+ break;
+ }
+ }
+ else
+ {
+ if (oe->which == Z_External_octet && rl->u.dbrec.size > 0)
+ {
+ char *buf = (char*) oe->u.octet_aligned->buf;
+ if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
+ memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
+ }
+ else if (rl->u.dbrec.type == VAL_SUTRS &&
+ oe->which == Z_External_sutrs)
+ {
+ if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
+ {
+ memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
+ oe->u.sutrs->len);
+ rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
+ }
+ rl->u.dbrec.size = oe->u.sutrs->len;
+ }
+ else if (rl->u.dbrec.type == VAL_GRS1 &&
+ oe->which == Z_External_grs1)
+ {
+ ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
+ }
+ }
+}
+
+static void ir_handleZRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
const char *elements)
{
IrTcl_Obj *p = o;
setobj->numberOfRecordsReturned =
zrs->u.databaseOrSurDiagnostics->num_records;
logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
- for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
+ for (offset = 0; offset < setobj->numberOfRecordsReturned; offset++)
{
- rl = new_IR_record (setobj, setobj->start + offset,
- zrs->u.databaseOrSurDiagnostics->
- records[offset]->which,
+ Z_NamePlusRecord *znpr = zrs->u.databaseOrSurDiagnostics->
+ records[offset];
+
+ rl = new_IR_record (setobj, setobj->start + offset, znpr->which,
elements);
if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
- {
ir_handleDiags (&rl->u.surrogateDiagnostics.list,
&rl->u.surrogateDiagnostics.num,
- &zrs->u.databaseOrSurDiagnostics->
- records[offset]->u.surrogateDiagnostic,
+ &znpr->u.surrogateDiagnostic,
1);
- }
else
- {
- Z_DatabaseRecord *zr;
- Z_External *oe;
- struct oident *ident;
-
- zr = zrs->u.databaseOrSurDiagnostics->records[offset]
- ->u.databaseRecord;
- oe = (Z_External*) zr;
- rl->u.dbrec.size = zr->u.octet_aligned->len;
-
- if ((ident = oid_getentbyoid (oe->direct_reference)))
- rl->u.dbrec.type = ident->value;
- else
- rl->u.dbrec.type = VAL_USMARC;
-
- if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
- {
- char *buf = (char*) zr->u.octet_aligned->buf;
- if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
- memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
- }
- else if (rl->u.dbrec.type == VAL_SUTRS &&
- oe->which == Z_External_sutrs)
- {
- odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
- oe->u.single_ASN1_type->len, 0);
- if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
- {
- memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
- oe->u.sutrs->len);
- rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
- }
- rl->u.dbrec.size = oe->u.sutrs->len;
- }
- else if (rl->u.dbrec.type == VAL_GRS1 &&
- oe->which == Z_External_grs1)
- {
- ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
- rl->u.dbrec.buf = NULL;
- }
- else
- rl->u.dbrec.buf = NULL;
- }
+ ir_handleDBRecord (p, rl,
+ (Z_External*) (znpr->u.databaseRecord));
}
}
else if (zrs->which == Z_Records_multipleNSD)
if (searchrs->nextResultSetPosition)
setobj->nextResultSetPosition = *searchrs->nextResultSetPosition;
- logf (LOG_DEBUG, "Search response %d, %d hits",
+ logf (LOG_DEBUG, "status %d hits %d",
setobj->searchStatus, setobj->resultCount);
if (zrs)
{
es = setobj->set_inher.smallSetElementSetNames;
else
es = setobj->set_inher.mediumSetElementSetNames;
- ir_handleRecords (o, zrs, setobj, es);
+ ir_handleZRecords (o, zrs, setobj, es);
}
else
setobj->recordFlag = 0;
get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId);
setobj->nextResultSetPosition = *presrs->nextResultSetPosition;
if (zrs)
- ir_handleRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
+ ir_handleZRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
else
{
setobj->recordFlag = 0;
scanobj->positionOfTerm = -1;
logf (LOG_DEBUG, "positionOfTerm=%d", scanobj->positionOfTerm);
- free (scanobj->entries);
+ xfree (scanobj->entries);
scanobj->entries = NULL;
ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList,
logf(LOG_DEBUG, "Read handler fd=%d", cs_fileno(p->cs_link));
if (p->state == IR_TCL_R_Connecting)
{
- logf(LOG_DEBUG, "read: connect");
+ logf(LOG_DEBUG, "read: connect");
r = cs_rcvconnect (p->cs_link);
if (r == 1)
{
}
p->state = IR_TCL_R_Idle;
p->ref_count = 2;
-#if IRTCL_GENERIC_FILES
- ir_select_remove_write (p->csFile, p);
-#else
ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
if (r < 0)
{
logf (LOG_DEBUG, "cs_rcvconnect error");
/* read incoming APDU */
if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) == 1)
- {
- logf(LOG_DEBUG, "PDU Fraction read");
+ {
+ logf(LOG_DEBUG, "PDU Fraction read");
return ;
- }
+ }
/* signal one more use of ir object - callbacks must not
release the ir memory (p pointer) */
p->ref_count = 2;
if (r <= 0)
{
logf (LOG_DEBUG, "cs_get failed, code %d", r);
-#if IRTCL_GENERIC_FILES
- ir_select_remove (p->csFile, p);
-#else
ir_select_remove (cs_fileno (p->cs_link), p);
-#endif
ir_tcl_disconnect (p);
if (p->failback)
{
if (!z_APDU (p->odr_in, &apdu, 0))
{
logf (LOG_DEBUG, "cs_get failed: %s",
- odr_errmsg (odr_geterror (p->odr_in)));
+ odr_errmsg (odr_geterror (p->odr_in)));
ir_tcl_disconnect (p);
if (p->failback)
{
ir_obj_delete (p);
return;
}
- logf(LOG_DEBUG, "Decoded ok");
/* handle APDU and invoke callback */
rq = p->request_queue;
if (!rq)
exit (1);
}
object_name = rq->object_name;
- logf (LOG_DEBUG, "getCommandInfo (%s)", object_name);
+ logf (LOG_DEBUG, "Object %s", object_name);
apdu_call = NULL;
if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info))
{
case Z_APDU_initResponse:
p->eventType = "init";
ir_initResponse (p, apdu->u.initResponse);
- apdu_call = p->initResponse;
+ apdu_call = p->initResponse;
break;
case Z_APDU_searchResponse:
p->eventType = "search";
ir_tcl_eval (p->interp, apdu_call);
else if (rq->callback)
ir_tcl_eval (p->interp, rq->callback);
- free (rq->buf_out);
- free (rq->callback);
- free (rq->object_name);
- free (rq);
+ xfree (rq->buf_out);
+ xfree (rq->callback);
+ xfree (rq->object_name);
+ xfree (rq);
odr_reset (p->odr_in);
if (p->ref_count == 1)
{
/*
* ir_select_write: handle outgoing packages - not yet written.
*/
-static void ir_select_write (ClientData clientData)
+static int ir_select_write (ClientData clientData)
{
IrTcl_Obj *p = clientData;
int r;
logf (LOG_DEBUG, "Write handler fd=%d", cs_fileno(p->cs_link));
if (p->state == IR_TCL_R_Connecting)
{
- logf(LOG_DEBUG, "write: connect");
+ logf(LOG_DEBUG, "write: connect");
r = cs_rcvconnect (p->cs_link);
if (r == 1)
{
logf (LOG_DEBUG, "cs_rcvconnect returned 1");
- return;
+ return 2;
}
p->state = IR_TCL_R_Idle;
p->ref_count = 2;
-#if IRTCL_GENERIC_FILES
- ir_select_remove_write (p->csFile, p);
-#else
ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
if (r < 0)
{
logf (LOG_DEBUG, "cs_rcvconnect error");
ir_tcl_eval (p->interp, p->failback);
}
ir_obj_delete (p);
- return;
+ return 2;
}
if (p->callback)
ir_tcl_eval (p->interp, p->callback);
ir_obj_delete (p);
- return;
+ return 2;
}
rq = p->request_queue;
if (!rq || !rq->buf_out)
- return;
+ return 0;
assert (rq);
if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0)
{
logf (LOG_DEBUG, "cs_put write fail");
p->ref_count = 2;
- free (rq->buf_out);
+ xfree (rq->buf_out);
rq->buf_out = NULL;
ir_tcl_disconnect (p);
if (p->failback)
}
else if (r == 0) /* remove select bit */
{
- logf (LOG_DEBUG, "Write completed");
+ logf (LOG_DEBUG, "Write completed");
p->state = IR_TCL_R_Waiting;
-#if IRTCL_GENERIC_FILES
- ir_select_remove_write (p->csFile, p);
-#else
ir_select_remove_write (cs_fileno (p->cs_link), p);
-#endif
- free (rq->buf_out);
+ xfree (rq->buf_out);
rq->buf_out = NULL;
}
+ return 1;
}
static void ir_select_notify (ClientData clientData, int r, int w, int e)
{
- if (r)
- ir_select_read (clientData);
if (w)
- ir_select_write (clientData);
+ {
+ if (!ir_select_write (clientData) && r)
+ ir_select_read (clientData);
+ }
+ else if (r)
+ {
+ ir_select_read (clientData);
+ }
}
/* ------------------------------------------------------- */