X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=d6e166610009822a80ceacdf2db66e89fd2eb6a5;hb=545265679eca114e222956b7b274831a73b0e6ea;hp=9c155e37439725bf51fd390dbd3079ccfaa297f7;hpb=0f328c535de82e9b8401d6086403e2577344c8fd;p=ir-tcl-moved-to-github.git diff --git a/ir-tcl.c b/ir-tcl.c index 9c155e3..d6e1666 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,21 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.84 1996-03-07 12:42:49 adam + * 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 @@ -310,8 +324,6 @@ #define CS_BLOCK 0 -#define IRTCL_GENERIC_FILES 0 - #include "ir-tclp.h" static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num); @@ -402,8 +414,10 @@ int ir_tcl_eval (Tcl_Interp *interp, const char *command) 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); return r; @@ -588,6 +602,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; + logf (LOG_DEBUG, "init %s", *argv); if (!p->cs_link) { interp->result = "init: not connected"; @@ -1039,6 +1054,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, return TCL_OK; if (argc == 3) { + logf (LOG_DEBUG, "connect %s %s", *argv, argv[2]); if (p->hostname) { interp->result = "already connected"; @@ -1079,38 +1095,23 @@ static int do_connect (void *obj, Tcl_Interp *interp, } 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 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); @@ -1128,26 +1129,17 @@ void ir_tcl_disconnect (IrTcl_Obj *p) { if (p->hostname) { - logf(LOG_DEBUG, "Closing connection to %s", p->hostname); + logf(LOG_DEBUG, "Closing connection to %s", p->hostname); free (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); @@ -1178,9 +1170,6 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, 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); @@ -1600,8 +1589,9 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp, } else if (argc == 2) { - Tcl_AppendElement (interp, IrTcl_getRecordSyntaxStr - (*p->preferredRecordSyntax)); + Tcl_AppendElement + (interp,!p->preferredRecordSyntax ? "" : + IrTcl_getRecordSyntaxStr(*p->preferredRecordSyntax)); } return TCL_OK; @@ -1876,7 +1866,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) IrTcl_SetObj *obj = o; IrTcl_Obj *p; int r; - oident bib1; if (argc <= 0) return TCL_OK; @@ -1884,9 +1873,11 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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"; @@ -1902,10 +1893,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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); @@ -1958,21 +1945,20 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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")) @@ -1981,6 +1967,11 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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) @@ -1989,13 +1980,14 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) 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")) @@ -2004,7 +1996,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) query.u.type_2 = &ccl_query; ccl_query.buf = (unsigned char *) argv[2]; ccl_query.len = strlen (argv[2]); - logf (LOG_DEBUG, "CCL"); } else { @@ -2297,7 +2288,6 @@ static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num) for (i = 0; iparent; if (!p->cs_link) { @@ -2694,7 +2685,7 @@ static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp, 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; @@ -2812,8 +2803,8 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) 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 @@ -2825,6 +2816,7 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) 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"; @@ -2836,20 +2828,17 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) 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; @@ -2861,8 +2850,11 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) 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 @@ -3120,6 +3112,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, 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"; @@ -3209,6 +3202,7 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, *dst_list = ir_tcl_malloc (sizeof(**dst_list) * num); for (i = 0; iwhich) { case Z_DiagRec_defaultFormat: @@ -3217,6 +3211,9 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num, 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; @@ -3343,7 +3340,7 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs, 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) { @@ -3488,7 +3485,7 @@ static void ir_select_read (ClientData clientData) 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) { @@ -3497,11 +3494,7 @@ static void ir_select_read (ClientData clientData) } 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"); @@ -3528,21 +3521,17 @@ static void ir_select_read (ClientData clientData) /* 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) { @@ -3561,7 +3550,7 @@ static void ir_select_read (ClientData clientData) 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) { @@ -3573,7 +3562,6 @@ static void ir_select_read (ClientData clientData) ir_obj_delete (p); return; } - logf(LOG_DEBUG, "Decoded ok"); /* handle APDU and invoke callback */ rq = p->request_queue; if (!rq) @@ -3582,7 +3570,7 @@ static void ir_select_read (ClientData clientData) 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)) { @@ -3591,7 +3579,7 @@ static void ir_select_read (ClientData clientData) 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"; @@ -3661,7 +3649,7 @@ static void ir_select_write (ClientData clientData) 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) { @@ -3670,11 +3658,7 @@ static void ir_select_write (ClientData clientData) } 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"); @@ -3712,13 +3696,9 @@ static void ir_select_write (ClientData clientData) } 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); rq->buf_out = NULL; } @@ -3728,7 +3708,7 @@ static void ir_select_notify (ClientData clientData, int r, int w, int e) { if (r) ir_select_read (clientData); - if (w) + else if (w) ir_select_write (clientData); }