* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.41 1995-06-16 12:28:16 adam
+ * Revision 1.43 1995-06-19 13:06:08 adam
+ * New define: IR_TCL_VERSION.
+ *
+ * Revision 1.42 1995/06/19 08:08:52 adam
+ * client.tcl: hotTargets now contain both database and target name.
+ * ir-tcl.c: setting protocol edited. Errors in callbacks are logged
+ * by logf(LOG_WARN, ...) calls.
+ *
+ * Revision 1.41 1995/06/16 12:28:16 adam
* Implemented preferredRecordSyntax.
* Minor changes in diagnostic handling.
* Record list deleted when connection closes.
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);
}
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);
free (tmp);
return r;
}
static int do_protocolVersion (void *obj, Tcl_Interp *interp,
int argc, char **argv)
{
- static struct ir_named_entry version_tab[] = {
- { "1", 0 },
- { "2", 1 },
- { "3", 2 },
- { "4", 3 },
- { NULL,0}
- };
+ int version, i;
+ char buf[10];
IrTcl_Obj *p = obj;
if (argc <= 0)
ODR_MASK_SET (&p->protocolVersion, 1);
return TCL_OK;
}
- return ir_named_bits (version_tab, &p->protocolVersion,
- interp, argc-2, argv+2);
+ if (argc == 3)
+ {
+ if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR)
+ return TCL_ERROR;
+ ODR_MASK_ZERO (&p->protocolVersion);
+ for (i = 0; i<version; i++)
+ ODR_MASK_SET (&p->protocolVersion, i);
+ }
+ for (i = 4; --i >= 0; )
+ if (ODR_MASK_GET (&p->protocolVersion, i))
+ break;
+ sprintf (buf, "%d", i+1);
+ interp->result = buf;
+ return TCL_OK;
}
/*
{ "accessCtrl", 6},
{ "scan", 7},
{ "sort", 8},
- { "extentedServices", 10},
+ { "extendedServices", 10},
{ "level-1Segmentation", 11},
{ "level-2Segmentation", 12},
{ "concurrentOperations", 13},
if (argc <= 0)
{
- p->preferredMessageSize = 4096;
+ p->preferredMessageSize = 30000;
return TCL_OK;
}
return get_set_int (&p->preferredMessageSize, interp, argc, argv);
if (argc <= 0)
{
- p->maximumRecordSize = 32768;
+ p->maximumRecordSize = 30000;
return TCL_OK;
}
return get_set_int (&p->maximumRecordSize, interp, argc, argv);
if (argc == 0)
return ir_strdup (interp, &p->implementationName,
- "Index Data/TCL/TK on YAZ");
+ "Index Data/IrTcl on YAZ");
else if (argc == -1)
return ir_strdel (interp, &p->implementationName);
if (argc == 3)
IrTcl_Obj *p = obj;
if (argc == 0)
- return ir_strdup (interp, &p->implementationVersion, YAZ_VERSION);
+ return ir_strdup (interp, &p->implementationVersion,
+ "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
else if (argc == -1)
return ir_strdel (interp, &p->implementationVersion);
Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
return TCL_ERROR;
if ((r=cs_connect (p->cs_link, addr)) < 0)
{
- interp->result = "cs_connect fail";
+ interp->result = "connect fail";
do_disconnect (p, NULL, 2, NULL);
return TCL_ERROR;
}
ODR_MASK_SET (&p->options, 1);
ODR_MASK_SET (&p->options, 7);
ODR_MASK_SET (&p->options, 14);
+
+ ODR_MASK_ZERO (&p->protocolVersion);
+ ODR_MASK_SET (&p->protocolVersion, 0);
+ ODR_MASK_SET (&p->protocolVersion, 1);
}
assert (!p->cs_link);
return TCL_OK;
}
else
p->callback = NULL;
- p->interp = interp;
+ p->interp = irTcl_interp;
}
return TCL_OK;
}
}
else
p->failback = NULL;
- p->interp = interp;
+ p->interp = irTcl_interp;
}
return TCL_OK;
}
}
else if (argc == 3)
{
- if (!strcmp (argv[2], "Z3950"))
+ if (!strcmp (argv[2], "Z39"))
p->protocol_type = PROTO_Z3950;
else if (!strcmp (argv[2], "SR"))
p->protocol_type = PROTO_SR;
switch (p->protocol_type)
{
case PROTO_Z3950:
- Tcl_AppendElement (interp, "Z3950");
+ Tcl_AppendElement (interp, "Z39");
break;
case PROTO_SR:
Tcl_AppendElement (interp, "SR");
{
r = cs_rcvconnect (p->cs_link);
if (r == 1)
+ {
+ logf (LOG_WARN, "cs_rcvconnect returned 1");
return;
+ }
p->connectFlag = 0;
ir_select_remove_write (cs_fileno (p->cs_link), p);
if (r < 0)
(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;
}