From: Adam Dickmeiss Date: Thu, 29 Feb 1996 15:28:08 +0000 (+0000) Subject: First version of Wais extension to IrTcl. X-Git-Tag: IRTCL.1.4~145 X-Git-Url: http://jsfdemo.indexdata.com/cgi-bin?a=commitdiff_plain;h=7f48ddd1249d4310dfde21396e5a4babcae02327;p=ir-tcl-moved-to-github.git First version of Wais extension to IrTcl. --- diff --git a/wais-tcl.c b/wais-tcl.c new file mode 100644 index 0000000..74148ad --- /dev/null +++ b/wais-tcl.c @@ -0,0 +1,1156 @@ +/* + * NWI - Nordic Web Index + * Technical Knowledge Centre & Library of Denmark (DTV) + * + * Wais extension to IrTcl + * + * $Log: wais-tcl.c,v $ + * Revision 1.1 1996-02-29 15:28:08 adam + * First version of Wais extension to IrTcl. + * + */ + +#include +#include +#include + +/* YAZ headers ... */ +#include +#include +#include + +/* IrTcl internal header */ +#include + +/* FreeWAIS-sf header */ +#include + +typedef struct { + int position; + any *documentID; + long score; + long documentLength; + long lines; + char *headline; + char *documentText; +} WaisTcl_Record; + +typedef struct WaisTcl_Records { + WaisTcl_Record *record; + struct WaisTcl_Records *next; +} WaisTcl_Records; + +typedef struct { + IrTcl_Obj *irtcl_obj; + Tcl_Interp *interp; + int ref_count; + COMSTACK wais_link; + char *hostname; + char *buf_out; + int len_out; + int max_out; + char *object; +} WaisTcl_Obj; + +typedef struct { + WaisTcl_Obj *parent; + IrTcl_SetObj *irtcl_set_obj; + Tcl_Interp *interp; + WaisTcl_Records *records; + char *diag; + char *addinfo; + int maxDocs; +} WaisSetTcl_Obj; + +static void wais_obj_delete (ClientData clientData); +static void wais_select_notify (ClientData clientData, int r, int w, int e); +static int do_disconnect (void *obj, Tcl_Interp *interp, + int argc, char **argv); + +/* --- N E T W O R K I / O ----------------------------------------- */ + +static void wais_select_write (ClientData clientData) +{ + WaisTcl_Obj *p = clientData; + int r; + + logf (LOG_DEBUG, "Wais write handler fd=%d", cs_fileno(p->wais_link)); + switch (p->irtcl_obj->state) + { + case IR_TCL_R_Connecting: + logf(LOG_DEBUG, "Connect handler"); + r = cs_rcvconnect (p->wais_link); + if (r == 1) + return; + p->irtcl_obj->state = IR_TCL_R_Idle; + if (r < 0) + { + logf (LOG_DEBUG, "cs_rcvconnect error"); + 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"); + 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 */ + { + logf(LOG_DEBUG, "Write completed"); + p->irtcl_obj->state = IR_TCL_R_Waiting; + + ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link), + clientData, 1, 0, 0); + } + break; + default: + logf (LOG_FATAL|LOG_ERRNO, "Wais read. state=%d", p->irtcl_obj->state); + abort (); + } +} + +static WaisTcl_Record *wais_lookup_record_pos (WaisSetTcl_Obj *p, int pos) +{ + WaisTcl_Records *recs; + + for (recs = p->records; recs; recs = recs->next) + if (recs->record->position == pos) + return recs->record; + return NULL; +} + +static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos) +{ + WaisTcl_Record *rec; + + rec = wais_lookup_record_pos (p, pos); + if (!rec) + { + return NULL; + } + if (rec->documentText || + !p->irtcl_set_obj->recordElements || + !*p->irtcl_set_obj->recordElements || + strcmp (p->irtcl_set_obj->recordElements, "F")) + return rec; + 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); +} + +static void wais_add_record_brief (WaisSetTcl_Obj *p, + int position, + any *documentID, + long score, + long documentLength, + long lines, + char *headline) +{ + WaisTcl_Record *rec; + WaisTcl_Records *recs; + + rec = wais_lookup_record_pos (p, position); + if (!rec) + { + rec = ir_tcl_malloc (sizeof(*rec)); + + recs = ir_tcl_malloc (sizeof(*recs)); + recs->record = rec; + recs->next = p->records; + p->records = recs; + } + else + { + freeAny (rec->documentID); + free (rec->headline); + if (rec->documentText) + free (rec->documentText); + } + rec->position = position; + rec->documentID = duplicateAny (documentID); + rec->score = score; + rec->documentLength = documentLength; + rec->lines = lines; + ir_tcl_strdup (NULL, &rec->headline, headline); + rec->documentText = NULL; +} + +static void wais_add_record_full (WaisSetTcl_Obj *p, + any *documentID, + any *documentText) +{ + WaisTcl_Record *rec; + rec = wais_lookup_record_id (p, documentID); + + if (!rec) + { + logf (LOG_DEBUG, "Adding text. Didn't find corresponding brief"); + return ; + } + if (rec->documentText) + free (rec->documentText); + rec->documentText = ir_tcl_malloc (documentText->size+1); + memcpy (rec->documentText, documentText->bytes, documentText->size); + rec->documentText[documentText->size] = '\0'; + logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText); +} + +static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf) +{ + SearchResponseAPDU *responseAPDU = NULL; + + readSearchResponseAPDU (&responseAPDU, buf); + if (responseAPDU->DatabaseDiagnosticRecords) + { + WAISSearchResponse *ddr = responseAPDU->DatabaseDiagnosticRecords; + + p->irtcl_set_obj->searchStatus = 1; + + p->irtcl_set_obj->nextResultSetPosition = + responseAPDU->NextResultSetPosition; + p->irtcl_set_obj->numberOfRecordsReturned = + responseAPDU->NumberOfRecordsReturned; + + if (!p->irtcl_set_obj->resultCount) + { + if (responseAPDU->NumberOfRecordsReturned > + responseAPDU->ResultCount) + p->irtcl_set_obj->resultCount = + responseAPDU->NumberOfRecordsReturned; + else + p->irtcl_set_obj->resultCount = + responseAPDU->ResultCount; + } + free (p->diag); + p->diag = NULL; + free (p->addinfo); + p->addinfo = NULL; + if (ddr->Diagnostics) + { + diagnosticRecord **dr = ddr->Diagnostics; + if (dr[0]) + { + logf (LOG_DEBUG, "Diagnostic response. %s : %s", + dr[0]->DIAG ? dr[0]->DIAG : "", + dr[0]->ADDINFO ? dr[0]->ADDINFO : ""); + ir_tcl_strdup (NULL, &p->diag, dr[0]->DIAG); + ir_tcl_strdup (NULL, &p->addinfo, dr[0]->ADDINFO); + } + else + logf (LOG_DEBUG, "Diagnostic response"); + } + if (ddr->DocHeaders) + { + int i; + logf (LOG_DEBUG, "Got doc header entries"); + for (i = 0; ddr->DocHeaders[i]; i++) + { + WAISDocumentHeader *head = ddr->DocHeaders[i]; + + wais_add_record_brief (p, i+1, head->DocumentID, + head->Score, head->DocumentLength, + head->Lines, head->Headline); + } + logf (LOG_DEBUG, "got %d DBOSD records", i); + } + if (ddr->Text) + { + int i; + logf (LOG_DEBUG, "Got text entries"); + for (i = 0; ddr->Text[i]; i++) + wais_add_record_full (p, + ddr->Text[i]->DocumentID, + ddr->Text[i]->DocumentText); + } + freeWAISSearchResponse (ddr); + } + else + { + logf (LOG_DEBUG, "No records!"); + } + freeSearchResponseAPDU (responseAPDU); +} + + +static void wais_select_read (ClientData clientData) +{ + ClientData objectClientData; + WaisTcl_Obj *p = clientData; + char *pdup; + int r; + + logf (LOG_DEBUG, "Wais read handler fd=%d", cs_fileno(p->wais_link)); + do + { + /* 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) + { + logf (LOG_DEBUG, "cs_get failed, code %d", r); + do_disconnect (p, NULL, 2, NULL); + 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; + } + 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 */ + + /* determine set/ir object corresponding to response */ + objectClientData = 0; + if (p->object) + { + Tcl_CmdInfo cmd_info; + + if (Tcl_GetCommandInfo (p->interp, p->object, &cmd_info)) + objectClientData = cmd_info.clientData; + free (p->object); + p->object = NULL; + } + pdup = p->irtcl_obj->buf_in + HEADER_LENGTH; + switch (peekPDUType (pdup)) + { + case initResponseAPDU: + logf (LOG_DEBUG, "Got Wais Init response"); + break; + case searchResponseAPDU: + logf (LOG_DEBUG, "Got Wais Search response"); + if (objectClientData) + wais_handle_search_response (objectClientData, + pdup); + break; + default: + logf (LOG_WARN, "Received unknown WAIS APDU type %d", + peekPDUType (pdup)); + do_disconnect (p, NULL, 2, NULL); + if (p->irtcl_obj->failback) + { + p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU; + ir_tcl_eval (p->interp, p->irtcl_obj->failback); + } + return ; + } + p->irtcl_obj->state = IR_TCL_R_Idle; + + if (p->irtcl_obj->callback) + ir_tcl_eval (p->interp, p->irtcl_obj->callback); + if (p->ref_count == 1) + { + wais_obj_delete (p); + return; + } + --(p->ref_count); + } while (p->wais_link && cs_more (p->wais_link)); +} + +static void wais_select_notify (ClientData clientData, int r, int w, int e) +{ + if (w) + wais_select_write (clientData); + if (r) + wais_select_read (clientData); +} + +static int wais_send_apdu (WaisTcl_Obj *p, const char *msg, const char *object) +{ + int r; + + if (p->object) + { + logf (LOG_DEBUG, "Cannot send. object=%s", p->object); + return TCL_ERROR; + } + r = cs_put (p->wais_link, p->buf_out, p->len_out); + if (r < 0) + return TCL_ERROR; + ir_tcl_strdup (NULL, &p->object, object); + if (r == 1) + { + ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link), + p, 1, 1, 0); + logf (LOG_DEBUG, "Send part of wais %s APDU", msg); + p->irtcl_obj->state = IR_TCL_R_Writing; + } + else + { + logf (LOG_DEBUG, "Send %s (%d bytes) fd=%d", msg, p->len_out, + cs_fileno(p->wais_link)); + p->irtcl_obj->state = IR_TCL_R_Waiting; + } + return TCL_OK; +} + +/* --- A S S O C I A T I O N S ----------------------------------------- */ + +static int do_connect (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + void *addr; + WaisTcl_Obj *p = obj; + int r; + + if (argc <= 0) + return TCL_OK; + else if (argc == 2) + { + Tcl_AppendResult (interp, p->hostname, NULL); + return TCL_OK; + } + if (p->hostname) + { + interp->result = "already connected"; + return TCL_ERROR; + } + if (strcmp (p->irtcl_obj->comstackType, "wais")) + { + interp->result = "only wais comstack supported"; + return TCL_ERROR; + } + p->wais_link = cs_create (tcpip_type, 0, PROTO_WAIS); + addr = tcpip_strtoaddr (argv[2]); + if (!addr) + { + interp->result = "tcpip_strtoaddr fail"; + return TCL_ERROR; + } + logf (LOG_DEBUG, "tcp/ip wais connect %s", argv[2]); + + if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR) + return TCL_ERROR; + r = cs_connect (p->wais_link, addr); + logf(LOG_DEBUG, "cs_connect returned %d fd=%d", r, + cs_fileno(p->wais_link)); + if (r < 0) + { + interp->result = "wais connect fail"; + do_disconnect (p, NULL, 2, NULL); + return TCL_ERROR; + } + p->irtcl_obj->eventType = "connect"; + if (r == 1) + { + p->irtcl_obj->state = IR_TCL_R_Connecting; + ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link), + p, 1, 1, 0); + } + else + { + p->irtcl_obj->state = IR_TCL_R_Idle; + ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link), + p, 1, 0, 0); + if (p->irtcl_obj->callback) + ir_tcl_eval (p->interp, p->irtcl_obj->callback); + } + return TCL_OK; +} + +static int do_disconnect (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + WaisTcl_Obj *p = obj; + + if (argc == 0) + { + p->wais_link = NULL; + p->hostname = NULL; + p->object = NULL; + return TCL_OK; + } + if (p->hostname) + { + ir_tcl_select_set (NULL, cs_fileno(p->wais_link), NULL, 0, 0, 0); + + free (p->hostname); + p->hostname = NULL; + cs_close (p->wais_link); + p->wais_link = NULL; + free (p->object); + p->object = NULL; + } + return TCL_OK; +} + +static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv) +{ + WaisTcl_Obj *p = obj; + + if (argc <= 0) + return TCL_OK; + p->irtcl_obj->initResult = 0; + if (!p->hostname) + { + interp->result = "not connected"; + return TCL_ERROR; + } + p->irtcl_obj->initResult = 1; + if (p->irtcl_obj->callback) + ir_tcl_eval (p->interp, p->irtcl_obj->callback); + return TCL_OK; +} + +static int do_options (void *obj, Tcl_Interp *interp, int argc, char **argv) +{ + WaisTcl_Obj *p = obj; + + if (argc <= 0) + return TCL_OK; + if (argc != 2) + return TCL_OK; + Tcl_AppendElement (p->interp, "search"); + Tcl_AppendElement (p->interp, "present"); + return TCL_OK; +} + + +static IrTcl_Method wais_method_tab[] = { +{ "connect", do_connect, NULL }, +{ "disconnect", do_disconnect, NULL }, +{ "init", do_init, NULL }, +{ "options", do_options, NULL }, +{ NULL, NULL} +}; + + +int wais_obj_init(ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) +{ + IrTcl_Methods tab[3]; + WaisTcl_Obj *obj; + ClientData subP; + int r; + + if (argc != 2) + { + interp->result = "wrong # args"; + return TCL_ERROR; + } + obj = ir_tcl_malloc (sizeof(*obj)); + obj->ref_count = 1; + obj->interp = interp; + + logf (LOG_DEBUG, "wais object create %s", argv[1]); + + r = (*ir_obj_class.ir_init)(clientData, interp, argc, argv, &subP, 0); + if (r == TCL_ERROR) + return TCL_ERROR; + obj->irtcl_obj = subP; + + obj->max_out = 2048; + obj->buf_out = ir_tcl_malloc (obj->max_out); + + free (obj->irtcl_obj->comstackType); + ir_tcl_strdup (NULL, &obj->irtcl_obj->comstackType, "wais"); + + tab[0].tab = wais_method_tab; + tab[0].obj = obj; + tab[1].tab = NULL; + + if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR) + { + Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL); + /* cleanup missing ... */ + return TCL_ERROR; + } + *subData = obj; + return TCL_OK; +} + + +/* + * wais_obj_delete: Wais Object disposal + */ +static void wais_obj_delete (ClientData clientData) +{ + WaisTcl_Obj *obj = clientData; + IrTcl_Methods tab[3]; + + --(obj->ref_count); + if (obj->ref_count > 0) + return; + + logf (LOG_DEBUG, "wais object delete"); + + tab[0].tab = wais_method_tab; + tab[0].obj = obj; + tab[1].tab = NULL; + + ir_tcl_method (NULL, -1, NULL, tab, NULL); + + (*ir_obj_class.ir_delete)((ClientData) obj->irtcl_obj); + + free (obj->buf_out); + free (obj); +} + +/* + * wais_obj_method: Wais Object methods + */ +static int wais_obj_method (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Methods tab[3]; + WaisTcl_Obj *p = clientData; + int r; + + if (argc < 2) + return TCL_ERROR; + + tab[0].tab = wais_method_tab; + tab[0].obj = p; + tab[1].tab = NULL; + + if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR) + { + return (*ir_obj_class.ir_method)((ClientData) p->irtcl_obj, + interp, argc, argv); + } + return r; +} + +/* + * wais_obj_mk: Wais Object creation + */ +static int wais_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + ClientData subData; + int r = wais_obj_init (clientData, interp, argc, argv, &subData, 0); + + if (r == TCL_ERROR) + return TCL_ERROR; + Tcl_CreateCommand (interp, argv[1], wais_obj_method, + subData, wais_obj_delete); + return TCL_OK; +} + +/* --- S E T S ---------------------------------------------------------- */ + +static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + WaisSetTcl_Obj *obj = o; + WaisTcl_Obj *p = obj->parent; + int i, start, number; + static char *element_names[3]; + long left; + char *retp; + any *waisQuery; + SearchAPDU *waisSearch; + DocObj **docObjs; + + if (argc <= 0) + return TCL_OK; + if (argc >= 3) + { + if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR) + return TCL_ERROR; + } + else + start = 1; + if (argc >= 4) + { + if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR) + return TCL_ERROR; + } + else + number = 10; + if (!p->wais_link) + { + interp->result = "present: not connected"; + return TCL_ERROR; + } + element_names[0] = " "; + element_names[1] = ES_DocumentText; + element_names[2] = NULL; + + 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] = NULL; + waisQuery = makeWAISTextQuery (docObjs); + waisSearch = + makeSearchAPDU (30L, /* small */ + 5000L, /* large */ + 30L, /* medium */ + (boolean) obj->irtcl_set_obj-> + set_inher.replaceIndicator, /* replace indicator */ + obj->irtcl_set_obj-> + setName, /* result set name */ + obj->irtcl_set_obj->set_inher.databaseNames, + QT_TextRetrievalQuery, /* query type */ + element_names, /* element name */ + NULL, /* reference ID */ + waisQuery); + + left = p->max_out; + retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left); + p->len_out = p->max_out - left; + + for (i = 0; iresult = "Couldn't encode WAIS text search APDU"; + return TCL_ERROR; + } + writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais", + (long) NO_COMPRESSION, + (long) NO_ENCODING, + (long) HEADER_VERSION); + + p->len_out += HEADER_LENGTH; + return wais_send_apdu (p, "search", argv[0]); +} + +static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + WaisSetTcl_Obj *obj = o; + WaisTcl_Obj *p = obj->parent; + WAISSearch *waisQuery; + SearchAPDU *waisSearch; + char *retp; + long left; + + if (argc <= 0) + return TCL_OK; + if (argc != 3) + { + interp->result = "wrong # args"; + return TCL_ERROR; + } + if (!obj->irtcl_set_obj->set_inher.num_databaseNames) + { + interp->result = "no databaseNames"; + return TCL_ERROR; + } + logf (LOG_DEBUG, "parent = %p", p); + if (!p->hostname) + { + interp->result = "not connected"; + return TCL_ERROR; + } + obj->irtcl_set_obj->resultCount = 0; + obj->irtcl_set_obj->searchStatus = 0; + waisQuery = + makeWAISSearch (argv[2], /* seed words */ + 0, /* doc ptrs */ + 0, /* text list */ + 1L, /* date factor */ + 0L, /* begin date range */ + 0L, /* end date range */ + obj->maxDocs); /* max docs retrieved */ + + waisSearch = + makeSearchAPDU (30L, /* small */ + 5000L, /* large */ + 30L, /* medium */ + (boolean) obj->irtcl_set_obj-> + set_inher.replaceIndicator, /* replace indicator */ + obj->irtcl_set_obj-> + setName, /* result set name */ + obj->irtcl_set_obj->set_inher.databaseNames, + QT_RelevanceFeedbackQuery, /* query type */ + NULL, /* element name */ + NULL, /* reference ID */ + waisQuery); + + left = p->max_out; + retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left); + p->len_out = p->max_out - left; + + CSTFreeWAISSearch (waisQuery); + freeSearchAPDU (waisSearch); + if (!retp) + { + interp->result = "Couldn't encode WAIS search APDU"; + return TCL_ERROR; + } + writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais", + (long) NO_COMPRESSION, + (long) NO_ENCODING, + (long) HEADER_VERSION); + + p->len_out += HEADER_LENGTH; + return wais_send_apdu (p, "search", argv[0]); +} + +/* + * do_responseStatus: Return response status (present or search) + */ +static int do_responseStatus (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + WaisSetTcl_Obj *obj = o; + + if (argc == 0) + { + obj->diag = NULL; + obj->addinfo = NULL; + return TCL_OK; + } + else if (argc == -1) + { + free (obj->diag); + free (obj->addinfo); + } + if (obj->diag) + { + Tcl_AppendElement (interp, "NSD"); + + Tcl_AppendElement (interp, obj->diag); + Tcl_AppendElement (interp, obj->diag); + + Tcl_AppendElement (interp, obj->addinfo ? obj->addinfo : ""); + return TCL_OK; + } + Tcl_AppendElement (interp, "DBOSD"); + return TCL_OK; +} + +/* + * do_maxDocs: Set number of documents to be retrieved in ranked query + */ +static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + WaisSetTcl_Obj *obj = o; + + if (argc <= 0) + { + obj->maxDocs = 100; + return TCL_OK; + } + return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv); +} + + +/* + * do_type: Return type (if any) at position. + */ +static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + WaisSetTcl_Obj *obj = o; + int offset; + WaisTcl_Record *rec; + + if (argc == 0) + { + obj->records = NULL; + return TCL_OK; + } + else if (argc == -1) + { +/* + delete_IR_records (obj); +*/ + 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; + rec = wais_lookup_record_pos_bf (obj, offset); + if (!rec) + { + logf (LOG_DEBUG, "No record at position %d", offset); + return TCL_OK; + } + interp->result = "DB"; + return TCL_OK; +} + + +/* + * do_recordType: Return record type (if any) at position. + */ +static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) +{ + WaisSetTcl_Obj *obj = o; + int offset; + WaisTcl_Record *rec; + + 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; + + rec = wais_lookup_record_pos_bf (obj, offset); + if (!rec) + return TCL_OK; + + Tcl_AppendElement (interp, "WAIS"); + return TCL_OK; +} + +/* + * do_getWAIS: Return WAIS record at position. + */ +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]; + + if (argc <= 0) + { + return TCL_OK; + } + if (argc != 4) + { + sprintf (interp->result, "wrong # args"); + return TCL_ERROR; + } + if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) + return TCL_ERROR; + rec = wais_lookup_record_pos_bf (obj, offset); + if (!rec) + return TCL_OK; + if (!strcmp (argv[3], "score")) + { + sprintf (prbuf, "%ld", (long) rec->score); + Tcl_AppendElement (interp, prbuf); + } + else if (!strcmp (argv[3], "headline")) + { + Tcl_AppendElement (interp, rec->headline); + } + else if (!strcmp (argv[3], "documentLength")) + { + sprintf (prbuf, "%ld", (long) rec->documentLength); + Tcl_AppendElement (interp, prbuf); + } + else if (!strcmp (argv[3], "text")) + { + Tcl_AppendElement (interp, rec->documentText); + } + else if (!strcmp (argv[3], "lines")) + { + sprintf (prbuf, "%ld", (long) rec->lines); + Tcl_AppendElement (interp, prbuf); + } + return TCL_OK; +} + + +static IrTcl_Method wais_set_method_tab[] = { +{ "maxDocs", do_maxDocs, NULL }, +{ "search", do_search, NULL }, +{ "present", do_present, NULL }, +{ "responseStatus", do_responseStatus, NULL }, +{ "type", do_type, NULL }, +{ "recordType", do_recordType, NULL }, +{ "getWAIS", do_getWAIS, NULL }, +{ NULL, NULL} +}; + +/* + * wais_obj_method: Wais Set Object methods + */ +static int wais_set_obj_method (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + IrTcl_Methods tab[3]; + WaisSetTcl_Obj *p = clientData; + int r; + + if (argc < 2) + return TCL_ERROR; + + tab[0].tab = wais_set_method_tab; + tab[0].obj = p; + tab[1].tab = NULL; + + if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR) + { + return (*ir_set_obj_class.ir_method)((ClientData) p->irtcl_set_obj, + interp, argc, argv); + } + return r; +} + +int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) +{ + IrTcl_Methods tab[3]; + WaisSetTcl_Obj *obj; + ClientData subP; + int r; + + 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); + obj->interp = interp; + obj->diag = NULL; + obj->addinfo = NULL; + + logf (LOG_DEBUG, "wais set object create %s", argv[1]); + + r = (*ir_set_obj_class.ir_init)(clientData, interp, argc, argv, &subP, + obj->parent->irtcl_obj); + if (r == TCL_ERROR) + return TCL_ERROR; + obj->irtcl_set_obj = subP; + + tab[0].tab = wais_set_method_tab; + tab[0].obj = obj; + tab[1].tab = NULL; + + if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR) + { + Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL); + /* cleanup missing ... */ + return TCL_ERROR; + } + *subData = obj; + return TCL_OK; +} + + +/* + * wais_set_obj_delete: Wais Set Object disposal + */ +static void wais_set_obj_delete (ClientData clientData) +{ + WaisSetTcl_Obj *obj = clientData; + IrTcl_Methods tab[3]; + + logf (LOG_DEBUG, "wais set object delete"); + + tab[0].tab = wais_set_method_tab; + tab[0].obj = obj; + tab[1].tab = NULL; + + ir_tcl_method (NULL, -1, NULL, tab, NULL); + + (*ir_set_obj_class.ir_delete)((ClientData) obj->irtcl_set_obj); + + free (obj); +} + +/* + * wais_set_obj_mk: Wais Set Object creation + */ +static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + int r; + ClientData subData; + Tcl_CmdInfo parent_info; + + if (argc != 3) + { + interp->result = "wrong # args"; + return TCL_ERROR; + } + parent_info.clientData = 0; + if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) + { + interp->result = "No parent"; + return TCL_ERROR; + } + r = wais_set_obj_init (clientData, interp, argc, argv, &subData, + parent_info.clientData); + if (r == TCL_ERROR) + return TCL_ERROR; + Tcl_CreateCommand (interp, argv[1], wais_set_obj_method, + subData, wais_set_obj_delete); + return TCL_OK; +} + + +/* --- 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_CmdDeleteProc *) NULL); + Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + return TCL_OK; +} +