* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.52 1995-08-04 11:32:38 adam
+ * Revision 1.55 1995-08-28 09:43:25 adam
+ * Minor changes. configure only searches for yaz beta 3 and versions after
+ * that.
+ *
+ * Revision 1.54 1995/08/24 12:25:16 adam
+ * Modified to work with yaz 1.0b3.
+ *
+ * Revision 1.53 1995/08/04 12:49:26 adam
+ * Bug fix: reading uninitialized variable p.
+ *
+ * Revision 1.52 1995/08/04 11:32:38 adam
* More work on output queue. Memory related routines moved
* to mem.c
*
IrTcl_Method *tab;
} IrTcl_Methods;
-static Tcl_Interp *irTcl_interp;
-
static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num);
static int do_disconnect (void *obj, Tcl_Interp *interp,
int argc, char **argv);
return TCL_OK;
if (!p->cs_link)
{
- interp->result = "not connected";
+ interp->result = "init: not connected";
return TCL_ERROR;
}
apdu = zget_APDU (p->odr_out, Z_APDU_initRequest);
}
else
p->callback = NULL;
- p->interp = interp;
}
return TCL_OK;
}
}
else
p->failback = NULL;
- p->interp = interp;
}
return TCL_OK;
}
return TCL_OK;
if (!p->cs_link)
{
- interp->result = "not connected";
+ interp->result = "triggerResourceControl: not connected";
return TCL_ERROR;
}
apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest);
obj->odr_out = odr_createmem (ODR_ENCODE);
obj->odr_pr = odr_createmem (ODR_PRINT);
obj->state = IR_TCL_R_Idle;
+ obj->interp = interp;
obj->len_in = 0;
obj->buf_in = NULL;
}
if (!p->cs_link)
{
- interp->result = "not connected";
+ interp->result = "search: not connected";
return TCL_ERROR;
}
apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest);
* do_present: Perform Present Request
*/
-static int do_present (void *o, Tcl_Interp *interp,
- int argc, char **argv)
+static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
{
IrTcl_SetObj *obj = o;
IrTcl_Obj *p;
}
else
number = 10;
+ p = obj->parent;
if (!p->cs_link)
{
- interp->result = "not connected";
+ interp->result = "present: not connected";
return TCL_ERROR;
}
- p = obj->parent;
obj->start = start;
obj->number = number;
dst = &obj->set_inher;
src = &obj->parent->set_inher;
- dst->num_databaseNames = src->num_databaseNames;
- dst->databaseNames =
- ir_tcl_malloc (sizeof (*dst->databaseNames)
- * dst->num_databaseNames);
+ if ((dst->num_databaseNames = src->num_databaseNames))
+ dst->databaseNames =
+ ir_tcl_malloc (sizeof (*dst->databaseNames)
+ * dst->num_databaseNames);
+ else
+ dst->databaseNames = NULL;
for (i = 0; i < dst->num_databaseNames; i++)
- {
if (ir_tcl_strdup (interp, &dst->databaseNames[i],
src->databaseNames[i]) == TCL_ERROR)
return TCL_ERROR;
- }
if (ir_tcl_strdup (interp, &dst->queryType, src->queryType)
== TCL_ERROR)
return TCL_ERROR;
}
if (!p->cs_link)
{
- interp->result = "not connected";
+ interp->result = "scan: not connected";
return TCL_ERROR;
}
else
{
Z_DatabaseRecord *zr;
- Odr_external *oe;
+ Z_External *oe;
struct oident *ident;
zr = zrs->u.databaseOrSurDiagnostics->records[offset]
->u.databaseRecord;
- oe = (Odr_external*) zr;
+ oe = (Z_External*) zr;
rl->u.dbrec.size = zr->u.octet_aligned->len;
rl->u.dbrec.type = VAL_USMARC;
memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
}
else if (rl->u.dbrec.type == VAL_SUTRS &&
- oe->which == ODR_EXTERNAL_single)
+ oe->which == Z_External_sutrs)
{
- Odr_oct *rc;
-
- logf (LOG_DEBUG, "Decoding SUTRS");
odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
oe->u.single_ASN1_type->len, 0);
- if (!z_SUTRS(p->odr_in, &rc, 0))
+ if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
{
- logf (LOG_WARN, "Cannot decode SUTRS");
- rl->u.dbrec.buf = NULL;
- }
- else
- {
- if ((rl->u.dbrec.buf = ir_tcl_malloc (rc->len+1)))
- {
- memcpy (rl->u.dbrec.buf, rc->buf, rc->len);
- rl->u.dbrec.buf[rc->len] = '\0';
- }
- rl->u.dbrec.size = rc->len;
+ 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
rl->u.dbrec.buf = NULL;
exit (1);
}
object_name = rq->object_name;
+ logf (LOG_DEBUG, "getCommandInfo (%s)", object_name);
if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info))
{
switch(apdu->which)
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand (interp, "ir-scan", ir_scan_obj_mk,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
- irTcl_interp = interp;
return TCL_OK;
}
-
-