X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=wais-tcl.c;h=d61dd1ff29819ce05edb6790bd636ec88a5ffc4e;hb=d026c3e06f6e19e5ed4174ab1a504a4b5af79183;hp=74148ad671b4f7159b5ae4b715e183f71c380427;hpb=7f48ddd1249d4310dfde21396e5a4babcae02327;p=ir-tcl-moved-to-github.git diff --git a/wais-tcl.c b/wais-tcl.c index 74148ad..d61dd1f 100644 --- a/wais-tcl.c +++ b/wais-tcl.c @@ -5,7 +5,19 @@ * Wais extension to IrTcl * * $Log: wais-tcl.c,v $ - * Revision 1.1 1996-02-29 15:28:08 adam + * Revision 1.5 1996-03-15 14:40:23 adam + * Bug fix: do_responseStatus called Tcl_AppendElement when interp was 0. + * + * Revision 1.4 1996/03/11 17:39:48 adam + * 40 documents are retrieved by default (maxDocs=40). + * + * Revision 1.3 1996/03/08 16:46:44 adam + * Doesn't use documentID to determine positions in present-response. + * + * Revision 1.2 1996/03/07 12:43:44 adam + * Better error handling. WAIS target closed before failback is invoked. + * + * Revision 1.1 1996/02/29 15:28:08 adam * First version of Wais extension to IrTcl. * */ @@ -60,6 +72,7 @@ typedef struct { char *diag; char *addinfo; int maxDocs; + int presentOffset; } WaisSetTcl_Obj; static void wais_obj_delete (ClientData clientData); @@ -78,7 +91,7 @@ static void wais_select_write (ClientData clientData) switch (p->irtcl_obj->state) { case IR_TCL_R_Connecting: - logf(LOG_DEBUG, "Connect handler"); + logf(LOG_DEBUG, "write wais: connect"); r = cs_rcvconnect (p->wais_link); if (r == 1) return; @@ -86,32 +99,27 @@ static void wais_select_write (ClientData clientData) if (r < 0) { logf (LOG_DEBUG, "cs_rcvconnect error"); + do_disconnect (p, NULL, 2, NULL); + p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT; if (p->irtcl_obj->failback) - { - p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT; ir_tcl_eval (p->interp, p->irtcl_obj->failback); - } - do_disconnect (p, NULL, 2, NULL); return; } ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link), clientData, 1, 0, 0); if (p->irtcl_obj->callback) - { - logf (LOG_DEBUG, "Invoking connect callback"); ir_tcl_eval (p->interp, p->irtcl_obj->callback); - } break; case IR_TCL_R_Writing: if ((r=cs_put (p->wais_link, p->buf_out, p->len_out)) < 0) { logf (LOG_DEBUG, "cs_put write fail"); + do_disconnect (p, NULL, 2, NULL); if (p->irtcl_obj->failback) { p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE; ir_tcl_eval (p->interp, p->irtcl_obj->failback); } - do_disconnect (p, NULL, 2, NULL); } else if (r == 0) /* remove select bit */ { @@ -155,26 +163,27 @@ static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos) return NULL; } -static WaisTcl_Record *wais_lookup_record_id (WaisSetTcl_Obj *p, any *id) -{ - WaisTcl_Records *recs; - - for (recs = p->records; recs; recs = recs->next) - if (recs->record->documentID->size == id->size && - !memcmp (recs->record->documentID->bytes, id->bytes, id->size)) - return recs->record; - return NULL; -} - static void wais_delete_record (WaisTcl_Record *rec) { freeAny (rec->documentID); free (rec->headline); - if (rec->documentText) - free (rec->documentText); + free (rec->documentText); free (rec); } +static void wais_delete_records (WaisSetTcl_Obj *p) +{ + WaisTcl_Records *recs, *recs1; + + for (recs = p->records; recs; recs = recs1) + { + recs1 = recs->next; + wais_delete_record (recs->record); + free (recs); + } + p->records = NULL; +} + static void wais_add_record_brief (WaisSetTcl_Obj *p, int position, any *documentID, @@ -213,11 +222,11 @@ static void wais_add_record_brief (WaisSetTcl_Obj *p, } static void wais_add_record_full (WaisSetTcl_Obj *p, - any *documentID, + int position, any *documentText) { WaisTcl_Record *rec; - rec = wais_lookup_record_id (p, documentID); + rec = wais_lookup_record_pos (p, position); if (!rec) { @@ -232,11 +241,16 @@ static void wais_add_record_full (WaisSetTcl_Obj *p, logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText); } -static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf) +static void wais_handle_search_response (WaisSetTcl_Obj *p, + SearchResponseAPDU *responseAPDU) { - SearchResponseAPDU *responseAPDU = NULL; + logf (LOG_DEBUG, "- SearchStatus=%d", responseAPDU->SearchStatus); + logf (LOG_DEBUG, "- ResultCount=%d", responseAPDU->ResultCount); + logf (LOG_DEBUG, "- NumberOfRecordsReturned=%d", + responseAPDU->NumberOfRecordsReturned); + logf (LOG_DEBUG, "- ResultSetStatus=%d", responseAPDU->ResultSetStatus); + logf (LOG_DEBUG, "- PresentStatus=%d", responseAPDU->PresentStatus); - readSearchResponseAPDU (&responseAPDU, buf); if (responseAPDU->DatabaseDiagnosticRecords) { WAISSearchResponse *ddr = responseAPDU->DatabaseDiagnosticRecords; @@ -250,14 +264,17 @@ static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf) if (!p->irtcl_set_obj->resultCount) { +#if 1 if (responseAPDU->NumberOfRecordsReturned > responseAPDU->ResultCount) p->irtcl_set_obj->resultCount = responseAPDU->NumberOfRecordsReturned; else +#endif p->irtcl_set_obj->resultCount = responseAPDU->ResultCount; } + logf (LOG_DEBUG, "resultCount=%d", p->irtcl_set_obj->resultCount); free (p->diag); p->diag = NULL; free (p->addinfo); @@ -279,11 +296,13 @@ static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf) if (ddr->DocHeaders) { int i; - logf (LOG_DEBUG, "Got doc header entries"); + logf (LOG_DEBUG, "Adding doc header entries"); for (i = 0; ddr->DocHeaders[i]; i++) { WAISDocumentHeader *head = ddr->DocHeaders[i]; + logf (LOG_DEBUG, "%4d -->%.*s<--", i+1, + head->DocumentID->size, head->DocumentID->bytes); wais_add_record_brief (p, i+1, head->DocumentID, head->Score, head->DocumentLength, head->Lines, head->Headline); @@ -293,10 +312,10 @@ static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf) if (ddr->Text) { int i; - logf (LOG_DEBUG, "Got text entries"); + logf (LOG_DEBUG, "Adding text entries"); for (i = 0; ddr->Text[i]; i++) wais_add_record_full (p, - ddr->Text[i]->DocumentID, + p->presentOffset + i, ddr->Text[i]->DocumentText); } freeWAISSearchResponse (ddr); @@ -311,6 +330,7 @@ static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf) static void wais_select_read (ClientData clientData) { + SearchResponseAPDU *searchRAPDU; ClientData objectClientData; WaisTcl_Obj *p = clientData; char *pdup; @@ -322,19 +342,17 @@ static void wais_select_read (ClientData clientData) /* signal one more use of ir object - callbacks must not release the ir memory (p pointer) */ p->irtcl_obj->state = IR_TCL_R_Reading; - ++(p->ref_count); /* read incoming APDU */ if ((r=cs_get (p->wais_link, &p->irtcl_obj->buf_in, &p->irtcl_obj->len_in)) <= 0) { + p->ref_count = 2; logf (LOG_DEBUG, "cs_get failed, code %d", r); do_disconnect (p, NULL, 2, NULL); + p->irtcl_obj->failInfo = IR_TCL_FAIL_READ; if (p->irtcl_obj->failback) - { - p->irtcl_obj->failInfo = IR_TCL_FAIL_READ; ir_tcl_eval (p->interp, p->irtcl_obj->failback); - } /* release wais object now if callback deleted it */ wais_obj_delete (p); return; @@ -342,12 +360,12 @@ static void wais_select_read (ClientData clientData) if (r == 1) { logf(LOG_DEBUG, "PDU Fraction read"); - --(p->ref_count); return ; } logf (LOG_DEBUG, "cs_get ok, total size %d", r); /* got complete APDU. Now decode */ + p->ref_count = 2; /* determine set/ir object corresponding to response */ objectClientData = 0; if (p->object) @@ -363,23 +381,36 @@ static void wais_select_read (ClientData clientData) switch (peekPDUType (pdup)) { case initResponseAPDU: + p->irtcl_obj->eventType = "init"; logf (LOG_DEBUG, "Got Wais Init response"); break; case searchResponseAPDU: + p->irtcl_obj->eventType = "search"; logf (LOG_DEBUG, "Got Wais Search response"); + + readSearchResponseAPDU (&searchRAPDU, pdup); + if (!searchRAPDU) + { + logf (LOG_WARN, "Couldn't decode Wais search APDU", + peekPDUType (pdup)); + p->irtcl_obj->failInfo = IR_TCL_FAIL_IN_APDU; + do_disconnect (p, NULL, 2, NULL); + if (p->irtcl_obj->failback) + ir_tcl_eval (p->interp, p->irtcl_obj->failback); + wais_obj_delete (p); + return ; + } if (objectClientData) - wais_handle_search_response (objectClientData, - pdup); + wais_handle_search_response (objectClientData, searchRAPDU); break; default: - logf (LOG_WARN, "Received unknown WAIS APDU type %d", + logf (LOG_WARN, "Received unknown Wais APDU type %d", peekPDUType (pdup)); do_disconnect (p, NULL, 2, NULL); + p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; if (p->irtcl_obj->failback) - { - p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; ir_tcl_eval (p->interp, p->irtcl_obj->failback); - } + wais_obj_delete (p); return ; } p->irtcl_obj->state = IR_TCL_R_Idle; @@ -403,7 +434,8 @@ static void wais_select_notify (ClientData clientData, int r, int w, int e) wais_select_read (clientData); } -static int wais_send_apdu (WaisTcl_Obj *p, const char *msg, const char *object) +static int wais_send_apdu (Tcl_Interp *interp, WaisTcl_Obj *p, + const char *msg, const char *object) { int r; @@ -414,7 +446,21 @@ static int wais_send_apdu (WaisTcl_Obj *p, const char *msg, const char *object) } r = cs_put (p->wais_link, p->buf_out, p->len_out); if (r < 0) - return TCL_ERROR; + { + p->irtcl_obj->state = IR_TCL_R_Idle; + p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE; + do_disconnect (p, NULL, 2, NULL); + if (p->irtcl_obj->failback) + { + ir_tcl_eval (p->interp, p->irtcl_obj->failback); + return TCL_OK; + } + else + { + interp->result = "Write failed when sending Wais PDU"; + return TCL_ERROR; + } + } ir_tcl_strdup (NULL, &p->object, object); if (r == 1) { @@ -535,6 +581,7 @@ static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv) return TCL_ERROR; } p->irtcl_obj->initResult = 1; + p->irtcl_obj->eventType = "init"; if (p->irtcl_obj->callback) ir_tcl_eval (p->interp, p->irtcl_obj->callback); return TCL_OK; @@ -689,6 +736,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) any *waisQuery; SearchAPDU *waisSearch; DocObj **docObjs; + any refID; if (argc <= 0) return TCL_OK; @@ -699,6 +747,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) } else start = 1; + obj->presentOffset = start; if (argc >= 4) { if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR) @@ -715,6 +764,9 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) element_names[1] = ES_DocumentText; element_names[2] = NULL; + refID.size = 1; + refID.bytes = "3"; + docObjs = ir_tcl_malloc (sizeof(*docObjs) * (number+1)); for (i = 0; iresult = "present request out of range"; return TCL_ERROR; } - docObjs[i] = makeDocObjUsingLines (rec->documentID, "TEXT", 0, 60000); + docObjs[i] = makeDocObjUsingBytes (rec->documentID, "TEXT", 0, + rec->documentLength); } docObjs[i] = NULL; waisQuery = makeWAISTextQuery (docObjs); @@ -741,7 +794,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) obj->irtcl_set_obj->set_inher.databaseNames, QT_TextRetrievalQuery, /* query type */ element_names, /* element name */ - NULL, /* reference ID */ + &refID, /* reference ID */ waisQuery); left = p->max_out; @@ -756,7 +809,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) freeSearchAPDU (waisSearch); if (!retp) { - interp->result = "Couldn't encode WAIS text search APDU"; + interp->result = "Couldn't encode Wais text search APDU"; return TCL_ERROR; } writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais", @@ -765,7 +818,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) (long) HEADER_VERSION); p->len_out += HEADER_LENGTH; - return wais_send_apdu (p, "search", argv[0]); + return wais_send_apdu (interp, p, "search", argv[0]); } static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) @@ -776,14 +829,27 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) SearchAPDU *waisSearch; char *retp; long left; + DocObj **docObjs = NULL; if (argc <= 0) return TCL_OK; - if (argc != 3) + if (argc < 3 || argc > 4) { interp->result = "wrong # args"; return TCL_ERROR; } + obj->presentOffset = 1; + if (argc == 4) + { + docObjs = ir_tcl_malloc (2 * sizeof(*docObjs)); + + docObjs[0] = ir_tcl_malloc (sizeof(**docObjs)); + docObjs[0]->DocumentID = stringToAny (argv[3]); + docObjs[0]->Type = NULL; + docObjs[0]->ChunkCode = (long) CT_document; + + docObjs[1] = NULL; + } if (!obj->irtcl_set_obj->set_inher.num_databaseNames) { interp->result = "no databaseNames"; @@ -799,7 +865,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) obj->irtcl_set_obj->searchStatus = 0; waisQuery = makeWAISSearch (argv[2], /* seed words */ - 0, /* doc ptrs */ + docObjs, /* doc ptrs */ 0, /* text list */ 1L, /* date factor */ 0L, /* begin date range */ @@ -815,7 +881,8 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) obj->irtcl_set_obj-> setName, /* result set name */ obj->irtcl_set_obj->set_inher.databaseNames, - QT_RelevanceFeedbackQuery, /* query type */ + QT_RelevanceFeedbackQuery, + /* query type */ NULL, /* element name */ NULL, /* reference ID */ waisQuery); @@ -826,9 +893,14 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) CSTFreeWAISSearch (waisQuery); freeSearchAPDU (waisSearch); + if (docObjs) + { + CSTFreeDocObj (docObjs[0]); + free (docObjs); + } if (!retp) { - interp->result = "Couldn't encode WAIS search APDU"; + interp->result = "Couldn't encode Wais search APDU"; return TCL_ERROR; } writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais", @@ -837,7 +909,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) (long) HEADER_VERSION); p->len_out += HEADER_LENGTH; - return wais_send_apdu (p, "search", argv[0]); + return wais_send_apdu (interp, p, "search", argv[0]); } /* @@ -858,6 +930,7 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, { free (obj->diag); free (obj->addinfo); + return TCL_OK; } if (obj->diag) { @@ -882,7 +955,7 @@ static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv) if (argc <= 0) { - obj->maxDocs = 100; + obj->maxDocs = 40; return TCL_OK; } return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv); @@ -905,9 +978,7 @@ static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) } else if (argc == -1) { -/* - delete_IR_records (obj); -*/ + wais_delete_records (obj); return TCL_OK; } if (argc != 3) @@ -965,7 +1036,7 @@ static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv) WaisSetTcl_Obj *obj = o; int offset; WaisTcl_Record *rec; - char prbuf[256]; + char prbuf[1024]; if (argc <= 0) { @@ -973,7 +1044,10 @@ static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv) } if (argc != 4) { - sprintf (interp->result, "wrong # args"); + sprintf (interp->result, "wrong # args: should be" + " \"assoc getWAIS pos field\"\n" + " field is one of:\n" + " score headline documentLength text lines documentID"); return TCL_ERROR; } if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) @@ -1004,6 +1078,17 @@ static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv) sprintf (prbuf, "%ld", (long) rec->lines); Tcl_AppendElement (interp, prbuf); } + else if (!strcmp (argv[3], "documentID")) + { + if (rec->documentID->size >= sizeof(prbuf)) + { + interp->result = "bad documentID"; + return TCL_ERROR; + } + memcpy (prbuf, rec->documentID->bytes, rec->documentID->size); + prbuf[rec->documentID->size] = '\0'; + Tcl_AppendElement (interp, prbuf); + } return TCL_OK; } @@ -1055,10 +1140,7 @@ int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp, assert (parentData); if (argc != 3) - { - interp->result = "wrong # args"; return TCL_ERROR; - } obj = ir_tcl_malloc (sizeof(*obj)); obj->parent = (WaisTcl_Obj *) parentData; logf (LOG_DEBUG, "parent = %p", obj->parent); @@ -1122,7 +1204,8 @@ static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp, if (argc != 3) { - interp->result = "wrong # args"; + interp->result = "wrong # args: should be" + " \"wais-set set assoc?\""; return TCL_ERROR; } parent_info.clientData = 0; @@ -1141,15 +1224,78 @@ static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp, } +/* + * do_htmlToken + */ +int do_htmlToken (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + const char *src; + char *tmp_buf = NULL; + int tmp_size = 0; + int r; + + if (argc != 4) + { + interp->result = "wrong # args: should be" + " \"htmlToken var list command\""; + return TCL_ERROR; + } + src = argv[2]; + while (*src) + { + const char *src1; + + if (*src == ' ' || *src == '\t' || *src == '\n' || + *src == '\r' || *src == '\f') + { + src++; + continue; + } + src1 = src + 1; + if (*src == '<') + { + while (*src1 != '>' && *src1 != '\n' ** src1) + src1++; + if (*src1 == '>') + src1++; + } + else + { + while (*src1 != '<' && *src1) + src1++; + } + if (src1 - src >= tmp_size) + { + free (tmp_buf); + tmp_size = src1 - src + 256; + tmp_buf = ir_tcl_malloc (tmp_size); + } + memcpy (tmp_buf, src, src1 - src); + tmp_buf[src1-src] = '\0'; + Tcl_SetVar (interp, argv[1], tmp_buf, 0); + r = Tcl_Eval (interp, argv[3]); + if (r != TCL_OK && r != TCL_CONTINUE) + break; + src = src1; + } + if (r == TCL_CONTINUE) + r = TCL_OK; + free (tmp_buf); + return r; +} + /* --- R E G I S T R A T I O N ---------------------------------------- */ /* * Waistcl_init: Registration of TCL commands. */ int Waistcl_Init (Tcl_Interp *interp) { - Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL, + Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk, + Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand (interp, "htmlToken", do_htmlToken, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; }