2 * NWI - Nordic Web Index
3 * Technical Knowledge Centre & Library of Denmark (DTV)
5 * Wais extension to IrTcl
8 * Revision 1.3 1996-03-08 16:46:44 adam
9 * Doesn't use documentID to determine positions in present-response.
11 * Revision 1.2 1996/03/07 12:43:44 adam
12 * Better error handling. WAIS target closed before failback is invoked.
14 * Revision 1.1 1996/02/29 15:28:08 adam
15 * First version of Wais extension to IrTcl.
28 /* IrTcl internal header */
31 /* FreeWAIS-sf header */
44 typedef struct WaisTcl_Records {
45 WaisTcl_Record *record;
46 struct WaisTcl_Records *next;
63 IrTcl_SetObj *irtcl_set_obj;
65 WaisTcl_Records *records;
72 static void wais_obj_delete (ClientData clientData);
73 static void wais_select_notify (ClientData clientData, int r, int w, int e);
74 static int do_disconnect (void *obj, Tcl_Interp *interp,
75 int argc, char **argv);
77 /* --- N E T W O R K I / O ----------------------------------------- */
79 static void wais_select_write (ClientData clientData)
81 WaisTcl_Obj *p = clientData;
84 logf (LOG_DEBUG, "Wais write handler fd=%d", cs_fileno(p->wais_link));
85 switch (p->irtcl_obj->state)
87 case IR_TCL_R_Connecting:
88 logf(LOG_DEBUG, "write wais: connect");
89 r = cs_rcvconnect (p->wais_link);
92 p->irtcl_obj->state = IR_TCL_R_Idle;
95 logf (LOG_DEBUG, "cs_rcvconnect error");
96 do_disconnect (p, NULL, 2, NULL);
97 p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT;
98 if (p->irtcl_obj->failback)
99 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
102 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
103 clientData, 1, 0, 0);
104 if (p->irtcl_obj->callback)
105 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
107 case IR_TCL_R_Writing:
108 if ((r=cs_put (p->wais_link, p->buf_out, p->len_out)) < 0)
110 logf (LOG_DEBUG, "cs_put write fail");
111 do_disconnect (p, NULL, 2, NULL);
112 if (p->irtcl_obj->failback)
114 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
115 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
118 else if (r == 0) /* remove select bit */
120 logf(LOG_DEBUG, "Write completed");
121 p->irtcl_obj->state = IR_TCL_R_Waiting;
123 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
124 clientData, 1, 0, 0);
128 logf (LOG_FATAL|LOG_ERRNO, "Wais read. state=%d", p->irtcl_obj->state);
133 static WaisTcl_Record *wais_lookup_record_pos (WaisSetTcl_Obj *p, int pos)
135 WaisTcl_Records *recs;
137 for (recs = p->records; recs; recs = recs->next)
138 if (recs->record->position == pos)
143 static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos)
147 rec = wais_lookup_record_pos (p, pos);
152 if (rec->documentText ||
153 !p->irtcl_set_obj->recordElements ||
154 !*p->irtcl_set_obj->recordElements ||
155 strcmp (p->irtcl_set_obj->recordElements, "F"))
160 static void wais_delete_record (WaisTcl_Record *rec)
162 freeAny (rec->documentID);
163 free (rec->headline);
164 free (rec->documentText);
168 static void wais_delete_records (WaisSetTcl_Obj *p)
170 WaisTcl_Records *recs, *recs1;
172 for (recs = p->records; recs; recs = recs1)
175 wais_delete_record (recs->record);
181 static void wais_add_record_brief (WaisSetTcl_Obj *p,
190 WaisTcl_Records *recs;
192 rec = wais_lookup_record_pos (p, position);
195 rec = ir_tcl_malloc (sizeof(*rec));
197 recs = ir_tcl_malloc (sizeof(*recs));
199 recs->next = p->records;
204 freeAny (rec->documentID);
205 free (rec->headline);
206 if (rec->documentText)
207 free (rec->documentText);
209 rec->position = position;
210 rec->documentID = duplicateAny (documentID);
212 rec->documentLength = documentLength;
214 ir_tcl_strdup (NULL, &rec->headline, headline);
215 rec->documentText = NULL;
218 static void wais_add_record_full (WaisSetTcl_Obj *p,
223 rec = wais_lookup_record_pos (p, position);
227 logf (LOG_DEBUG, "Adding text. Didn't find corresponding brief");
230 if (rec->documentText)
231 free (rec->documentText);
232 rec->documentText = ir_tcl_malloc (documentText->size+1);
233 memcpy (rec->documentText, documentText->bytes, documentText->size);
234 rec->documentText[documentText->size] = '\0';
235 logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText);
238 static void wais_handle_search_response (WaisSetTcl_Obj *p,
239 SearchResponseAPDU *responseAPDU)
241 logf (LOG_DEBUG, "- SearchStatus=%d", responseAPDU->SearchStatus);
242 logf (LOG_DEBUG, "- ResultCount=%d", responseAPDU->ResultCount);
243 logf (LOG_DEBUG, "- NumberOfRecordsReturned=%d",
244 responseAPDU->NumberOfRecordsReturned);
245 logf (LOG_DEBUG, "- ResultSetStatus=%d", responseAPDU->ResultSetStatus);
246 logf (LOG_DEBUG, "- PresentStatus=%d", responseAPDU->PresentStatus);
248 if (responseAPDU->DatabaseDiagnosticRecords)
250 WAISSearchResponse *ddr = responseAPDU->DatabaseDiagnosticRecords;
252 p->irtcl_set_obj->searchStatus = 1;
254 p->irtcl_set_obj->nextResultSetPosition =
255 responseAPDU->NextResultSetPosition;
256 p->irtcl_set_obj->numberOfRecordsReturned =
257 responseAPDU->NumberOfRecordsReturned;
259 if (!p->irtcl_set_obj->resultCount)
262 if (responseAPDU->NumberOfRecordsReturned >
263 responseAPDU->ResultCount)
264 p->irtcl_set_obj->resultCount =
265 responseAPDU->NumberOfRecordsReturned;
268 p->irtcl_set_obj->resultCount =
269 responseAPDU->ResultCount;
271 logf (LOG_DEBUG, "resultCount=%d", p->irtcl_set_obj->resultCount);
276 if (ddr->Diagnostics)
278 diagnosticRecord **dr = ddr->Diagnostics;
281 logf (LOG_DEBUG, "Diagnostic response. %s : %s",
282 dr[0]->DIAG ? dr[0]->DIAG : "<null>",
283 dr[0]->ADDINFO ? dr[0]->ADDINFO : "<null>");
284 ir_tcl_strdup (NULL, &p->diag, dr[0]->DIAG);
285 ir_tcl_strdup (NULL, &p->addinfo, dr[0]->ADDINFO);
288 logf (LOG_DEBUG, "Diagnostic response");
293 logf (LOG_DEBUG, "Adding doc header entries");
294 for (i = 0; ddr->DocHeaders[i]; i++)
296 WAISDocumentHeader *head = ddr->DocHeaders[i];
298 logf (LOG_DEBUG, "%4d -->%.*s<--", i+1,
299 head->DocumentID->size, head->DocumentID->bytes);
300 wais_add_record_brief (p, i+1, head->DocumentID,
301 head->Score, head->DocumentLength,
302 head->Lines, head->Headline);
304 logf (LOG_DEBUG, "got %d DBOSD records", i);
309 logf (LOG_DEBUG, "Adding text entries");
310 for (i = 0; ddr->Text[i]; i++)
312 logf (LOG_DEBUG, " size=%d", ddr->Text[i]->DocumentID->size);
314 logf (LOG_DEBUG, "-->%.*s<--",
315 ddr->Text[i]->DocumentID->size,
316 ddr->Text[i]->DocumentID->bytes);
318 wais_add_record_full (p,
319 p->presentOffset + i,
320 ddr->Text[i]->DocumentText);
323 freeWAISSearchResponse (ddr);
327 logf (LOG_DEBUG, "No records!");
329 freeSearchResponseAPDU (responseAPDU);
333 static void wais_select_read (ClientData clientData)
335 SearchResponseAPDU *searchRAPDU;
336 ClientData objectClientData;
337 WaisTcl_Obj *p = clientData;
341 logf (LOG_DEBUG, "Wais read handler fd=%d", cs_fileno(p->wais_link));
344 /* signal one more use of ir object - callbacks must not
345 release the ir memory (p pointer) */
346 p->irtcl_obj->state = IR_TCL_R_Reading;
348 /* read incoming APDU */
349 if ((r=cs_get (p->wais_link, &p->irtcl_obj->buf_in,
350 &p->irtcl_obj->len_in)) <= 0)
353 logf (LOG_DEBUG, "cs_get failed, code %d", r);
354 do_disconnect (p, NULL, 2, NULL);
355 p->irtcl_obj->failInfo = IR_TCL_FAIL_READ;
356 if (p->irtcl_obj->failback)
357 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
358 /* release wais object now if callback deleted it */
364 logf(LOG_DEBUG, "PDU Fraction read");
367 logf (LOG_DEBUG, "cs_get ok, total size %d", r);
368 /* got complete APDU. Now decode */
371 /* determine set/ir object corresponding to response */
372 objectClientData = 0;
375 Tcl_CmdInfo cmd_info;
377 if (Tcl_GetCommandInfo (p->interp, p->object, &cmd_info))
378 objectClientData = cmd_info.clientData;
382 pdup = p->irtcl_obj->buf_in + HEADER_LENGTH;
383 switch (peekPDUType (pdup))
385 case initResponseAPDU:
386 p->irtcl_obj->eventType = "init";
387 logf (LOG_DEBUG, "Got Wais Init response");
389 case searchResponseAPDU:
390 p->irtcl_obj->eventType = "search";
391 logf (LOG_DEBUG, "Got Wais Search response");
393 readSearchResponseAPDU (&searchRAPDU, pdup);
396 logf (LOG_WARN, "Couldn't decode Wais search APDU",
398 p->irtcl_obj->failInfo = IR_TCL_FAIL_IN_APDU;
399 do_disconnect (p, NULL, 2, NULL);
400 if (p->irtcl_obj->failback)
401 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
405 if (objectClientData)
406 wais_handle_search_response (objectClientData, searchRAPDU);
409 logf (LOG_WARN, "Received unknown Wais APDU type %d",
411 do_disconnect (p, NULL, 2, NULL);
412 p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
413 if (p->irtcl_obj->failback)
414 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
418 p->irtcl_obj->state = IR_TCL_R_Idle;
420 if (p->irtcl_obj->callback)
421 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
422 if (p->ref_count == 1)
428 } while (p->wais_link && cs_more (p->wais_link));
431 static void wais_select_notify (ClientData clientData, int r, int w, int e)
434 wais_select_write (clientData);
436 wais_select_read (clientData);
439 static int wais_send_apdu (Tcl_Interp *interp, WaisTcl_Obj *p,
440 const char *msg, const char *object)
446 logf (LOG_DEBUG, "Cannot send. object=%s", p->object);
449 r = cs_put (p->wais_link, p->buf_out, p->len_out);
452 p->irtcl_obj->state = IR_TCL_R_Idle;
453 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
454 do_disconnect (p, NULL, 2, NULL);
455 if (p->irtcl_obj->failback)
457 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
462 interp->result = "Write failed when sending Wais PDU";
466 ir_tcl_strdup (NULL, &p->object, object);
469 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
471 logf (LOG_DEBUG, "Send part of wais %s APDU", msg);
472 p->irtcl_obj->state = IR_TCL_R_Writing;
476 logf (LOG_DEBUG, "Send %s (%d bytes) fd=%d", msg, p->len_out,
477 cs_fileno(p->wais_link));
478 p->irtcl_obj->state = IR_TCL_R_Waiting;
483 /* --- A S S O C I A T I O N S ----------------------------------------- */
485 static int do_connect (void *obj, Tcl_Interp *interp,
486 int argc, char **argv)
489 WaisTcl_Obj *p = obj;
496 Tcl_AppendResult (interp, p->hostname, NULL);
501 interp->result = "already connected";
504 if (strcmp (p->irtcl_obj->comstackType, "wais"))
506 interp->result = "only wais comstack supported";
509 p->wais_link = cs_create (tcpip_type, 0, PROTO_WAIS);
510 addr = tcpip_strtoaddr (argv[2]);
513 interp->result = "tcpip_strtoaddr fail";
516 logf (LOG_DEBUG, "tcp/ip wais connect %s", argv[2]);
518 if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
520 r = cs_connect (p->wais_link, addr);
521 logf(LOG_DEBUG, "cs_connect returned %d fd=%d", r,
522 cs_fileno(p->wais_link));
525 interp->result = "wais connect fail";
526 do_disconnect (p, NULL, 2, NULL);
529 p->irtcl_obj->eventType = "connect";
532 p->irtcl_obj->state = IR_TCL_R_Connecting;
533 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
538 p->irtcl_obj->state = IR_TCL_R_Idle;
539 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
541 if (p->irtcl_obj->callback)
542 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
547 static int do_disconnect (void *obj, Tcl_Interp *interp,
548 int argc, char **argv)
550 WaisTcl_Obj *p = obj;
561 ir_tcl_select_set (NULL, cs_fileno(p->wais_link), NULL, 0, 0, 0);
565 cs_close (p->wais_link);
573 static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv)
575 WaisTcl_Obj *p = obj;
579 p->irtcl_obj->initResult = 0;
582 interp->result = "not connected";
585 p->irtcl_obj->initResult = 1;
586 p->irtcl_obj->eventType = "init";
587 if (p->irtcl_obj->callback)
588 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
592 static int do_options (void *obj, Tcl_Interp *interp, int argc, char **argv)
594 WaisTcl_Obj *p = obj;
600 Tcl_AppendElement (p->interp, "search");
601 Tcl_AppendElement (p->interp, "present");
606 static IrTcl_Method wais_method_tab[] = {
607 { "connect", do_connect, NULL },
608 { "disconnect", do_disconnect, NULL },
609 { "init", do_init, NULL },
610 { "options", do_options, NULL },
615 int wais_obj_init(ClientData clientData, Tcl_Interp *interp,
616 int argc, char **argv, ClientData *subData,
617 ClientData parentData)
619 IrTcl_Methods tab[3];
626 interp->result = "wrong # args";
629 obj = ir_tcl_malloc (sizeof(*obj));
631 obj->interp = interp;
633 logf (LOG_DEBUG, "wais object create %s", argv[1]);
635 r = (*ir_obj_class.ir_init)(clientData, interp, argc, argv, &subP, 0);
638 obj->irtcl_obj = subP;
641 obj->buf_out = ir_tcl_malloc (obj->max_out);
643 free (obj->irtcl_obj->comstackType);
644 ir_tcl_strdup (NULL, &obj->irtcl_obj->comstackType, "wais");
646 tab[0].tab = wais_method_tab;
650 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
652 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
653 /* cleanup missing ... */
662 * wais_obj_delete: Wais Object disposal
664 static void wais_obj_delete (ClientData clientData)
666 WaisTcl_Obj *obj = clientData;
667 IrTcl_Methods tab[3];
670 if (obj->ref_count > 0)
673 logf (LOG_DEBUG, "wais object delete");
675 tab[0].tab = wais_method_tab;
679 ir_tcl_method (NULL, -1, NULL, tab, NULL);
681 (*ir_obj_class.ir_delete)((ClientData) obj->irtcl_obj);
688 * wais_obj_method: Wais Object methods
690 static int wais_obj_method (ClientData clientData, Tcl_Interp *interp,
691 int argc, char **argv)
693 IrTcl_Methods tab[3];
694 WaisTcl_Obj *p = clientData;
700 tab[0].tab = wais_method_tab;
704 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
706 return (*ir_obj_class.ir_method)((ClientData) p->irtcl_obj,
713 * wais_obj_mk: Wais Object creation
715 static int wais_obj_mk (ClientData clientData, Tcl_Interp *interp,
716 int argc, char **argv)
719 int r = wais_obj_init (clientData, interp, argc, argv, &subData, 0);
723 Tcl_CreateCommand (interp, argv[1], wais_obj_method,
724 subData, wais_obj_delete);
728 /* --- S E T S ---------------------------------------------------------- */
730 static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
732 WaisSetTcl_Obj *obj = o;
733 WaisTcl_Obj *p = obj->parent;
734 int i, start, number;
735 static char *element_names[3];
739 SearchAPDU *waisSearch;
747 if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
752 obj->presentOffset = start;
755 if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
762 interp->result = "present: not connected";
765 element_names[0] = " ";
766 element_names[1] = ES_DocumentText;
767 element_names[2] = NULL;
772 docObjs = ir_tcl_malloc (sizeof(*docObjs) * (number+1));
773 for (i = 0; i<number; i++)
777 rec = wais_lookup_record_pos (obj, i+start);
780 interp->result = "present request out of range";
783 docObjs[i] = makeDocObjUsingBytes (rec->documentID, "TEXT", 0,
784 rec->documentLength);
787 waisQuery = makeWAISTextQuery (docObjs);
789 makeSearchAPDU (30L, /* small */
792 (boolean) obj->irtcl_set_obj->
793 set_inher.replaceIndicator, /* replace indicator */
795 setName, /* result set name */
796 obj->irtcl_set_obj->set_inher.databaseNames,
797 QT_TextRetrievalQuery, /* query type */
798 element_names, /* element name */
799 &refID, /* reference ID */
803 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
804 p->len_out = p->max_out - left;
806 for (i = 0; i<number; i++)
807 CSTFreeDocObj (docObjs[i]);
810 CSTFreeWAISTextQuery (waisQuery);
811 freeSearchAPDU (waisSearch);
814 interp->result = "Couldn't encode Wais text search APDU";
817 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
818 (long) NO_COMPRESSION,
820 (long) HEADER_VERSION);
822 p->len_out += HEADER_LENGTH;
823 return wais_send_apdu (interp, p, "search", argv[0]);
826 static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
828 WaisSetTcl_Obj *obj = o;
829 WaisTcl_Obj *p = obj->parent;
830 WAISSearch *waisQuery;
831 SearchAPDU *waisSearch;
834 DocObj **docObjs = NULL;
838 if (argc < 3 || argc > 4)
840 interp->result = "wrong # args";
843 obj->presentOffset = 1;
846 docObjs = ir_tcl_malloc (2 * sizeof(*docObjs));
848 docObjs[0] = ir_tcl_malloc (sizeof(**docObjs));
849 docObjs[0]->DocumentID = stringToAny (argv[3]);
850 docObjs[0]->Type = NULL;
851 docObjs[0]->ChunkCode = (long) CT_document;
855 if (!obj->irtcl_set_obj->set_inher.num_databaseNames)
857 interp->result = "no databaseNames";
860 logf (LOG_DEBUG, "parent = %p", p);
863 interp->result = "not connected";
866 obj->irtcl_set_obj->resultCount = 0;
867 obj->irtcl_set_obj->searchStatus = 0;
869 makeWAISSearch (argv[2], /* seed words */
870 docObjs, /* doc ptrs */
872 1L, /* date factor */
873 0L, /* begin date range */
874 0L, /* end date range */
875 obj->maxDocs); /* max docs retrieved */
878 makeSearchAPDU (30L, /* small */
881 (boolean) obj->irtcl_set_obj->
882 set_inher.replaceIndicator, /* replace indicator */
884 setName, /* result set name */
885 obj->irtcl_set_obj->set_inher.databaseNames,
886 QT_RelevanceFeedbackQuery,
888 NULL, /* element name */
889 NULL, /* reference ID */
893 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
894 p->len_out = p->max_out - left;
896 CSTFreeWAISSearch (waisQuery);
897 freeSearchAPDU (waisSearch);
900 CSTFreeDocObj (docObjs[0]);
905 interp->result = "Couldn't encode Wais search APDU";
908 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
909 (long) NO_COMPRESSION,
911 (long) HEADER_VERSION);
913 p->len_out += HEADER_LENGTH;
914 return wais_send_apdu (interp, p, "search", argv[0]);
918 * do_responseStatus: Return response status (present or search)
920 static int do_responseStatus (void *o, Tcl_Interp *interp,
921 int argc, char **argv)
923 WaisSetTcl_Obj *obj = o;
938 Tcl_AppendElement (interp, "NSD");
940 Tcl_AppendElement (interp, obj->diag);
941 Tcl_AppendElement (interp, obj->diag);
943 Tcl_AppendElement (interp, obj->addinfo ? obj->addinfo : "");
946 Tcl_AppendElement (interp, "DBOSD");
951 * do_maxDocs: Set number of documents to be retrieved in ranked query
953 static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv)
955 WaisSetTcl_Obj *obj = o;
962 return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv);
967 * do_type: Return type (if any) at position.
969 static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
971 WaisSetTcl_Obj *obj = o;
982 wais_delete_records (obj);
987 sprintf (interp->result, "wrong # args");
990 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
992 rec = wais_lookup_record_pos_bf (obj, offset);
995 logf (LOG_DEBUG, "No record at position %d", offset);
998 interp->result = "DB";
1004 * do_recordType: Return record type (if any) at position.
1006 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
1008 WaisSetTcl_Obj *obj = o;
1010 WaisTcl_Record *rec;
1018 sprintf (interp->result, "wrong # args");
1021 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1024 rec = wais_lookup_record_pos_bf (obj, offset);
1028 Tcl_AppendElement (interp, "WAIS");
1033 * do_getWAIS: Return WAIS record at position.
1035 static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv)
1037 WaisSetTcl_Obj *obj = o;
1039 WaisTcl_Record *rec;
1048 sprintf (interp->result, "wrong # args: should be"
1049 " \"assoc getWAIS pos field\"\n"
1050 " field is one of:\n"
1051 " score headline documentLength text lines documentID");
1054 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1056 rec = wais_lookup_record_pos_bf (obj, offset);
1059 if (!strcmp (argv[3], "score"))
1061 sprintf (prbuf, "%ld", (long) rec->score);
1062 Tcl_AppendElement (interp, prbuf);
1064 else if (!strcmp (argv[3], "headline"))
1066 Tcl_AppendElement (interp, rec->headline);
1068 else if (!strcmp (argv[3], "documentLength"))
1070 sprintf (prbuf, "%ld", (long) rec->documentLength);
1071 Tcl_AppendElement (interp, prbuf);
1073 else if (!strcmp (argv[3], "text"))
1075 Tcl_AppendElement (interp, rec->documentText);
1077 else if (!strcmp (argv[3], "lines"))
1079 sprintf (prbuf, "%ld", (long) rec->lines);
1080 Tcl_AppendElement (interp, prbuf);
1082 else if (!strcmp (argv[3], "documentID"))
1084 if (rec->documentID->size >= sizeof(prbuf))
1086 interp->result = "bad documentID";
1089 memcpy (prbuf, rec->documentID->bytes, rec->documentID->size);
1090 prbuf[rec->documentID->size] = '\0';
1091 Tcl_AppendElement (interp, prbuf);
1097 static IrTcl_Method wais_set_method_tab[] = {
1098 { "maxDocs", do_maxDocs, NULL },
1099 { "search", do_search, NULL },
1100 { "present", do_present, NULL },
1101 { "responseStatus", do_responseStatus, NULL },
1102 { "type", do_type, NULL },
1103 { "recordType", do_recordType, NULL },
1104 { "getWAIS", do_getWAIS, NULL },
1109 * wais_obj_method: Wais Set Object methods
1111 static int wais_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1112 int argc, char **argv)
1114 IrTcl_Methods tab[3];
1115 WaisSetTcl_Obj *p = clientData;
1121 tab[0].tab = wais_set_method_tab;
1125 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
1127 return (*ir_set_obj_class.ir_method)((ClientData) p->irtcl_set_obj,
1128 interp, argc, argv);
1133 int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp,
1134 int argc, char **argv, ClientData *subData,
1135 ClientData parentData)
1137 IrTcl_Methods tab[3];
1138 WaisSetTcl_Obj *obj;
1142 assert (parentData);
1145 obj = ir_tcl_malloc (sizeof(*obj));
1146 obj->parent = (WaisTcl_Obj *) parentData;
1147 logf (LOG_DEBUG, "parent = %p", obj->parent);
1148 obj->interp = interp;
1150 obj->addinfo = NULL;
1152 logf (LOG_DEBUG, "wais set object create %s", argv[1]);
1154 r = (*ir_set_obj_class.ir_init)(clientData, interp, argc, argv, &subP,
1155 obj->parent->irtcl_obj);
1158 obj->irtcl_set_obj = subP;
1160 tab[0].tab = wais_set_method_tab;
1164 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
1166 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
1167 /* cleanup missing ... */
1176 * wais_set_obj_delete: Wais Set Object disposal
1178 static void wais_set_obj_delete (ClientData clientData)
1180 WaisSetTcl_Obj *obj = clientData;
1181 IrTcl_Methods tab[3];
1183 logf (LOG_DEBUG, "wais set object delete");
1185 tab[0].tab = wais_set_method_tab;
1189 ir_tcl_method (NULL, -1, NULL, tab, NULL);
1191 (*ir_set_obj_class.ir_delete)((ClientData) obj->irtcl_set_obj);
1197 * wais_set_obj_mk: Wais Set Object creation
1199 static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1200 int argc, char **argv)
1204 Tcl_CmdInfo parent_info;
1208 interp->result = "wrong # args: should be"
1209 " \"wais-set set assoc?\"";
1212 parent_info.clientData = 0;
1213 if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
1215 interp->result = "No parent";
1218 r = wais_set_obj_init (clientData, interp, argc, argv, &subData,
1219 parent_info.clientData);
1222 Tcl_CreateCommand (interp, argv[1], wais_set_obj_method,
1223 subData, wais_set_obj_delete);
1231 int do_htmlToken (ClientData clientData, Tcl_Interp *interp,
1232 int argc, char **argv)
1235 char *tmp_buf = NULL;
1241 interp->result = "wrong # args: should be"
1242 " \"htmlToken var list command\"";
1250 if (*src == ' ' || *src == '\t' || *src == '\n' ||
1251 *src == '\r' || *src == '\f')
1259 while (*src1 != '>' && *src1 != '\n' ** src1)
1266 while (*src1 != '<' && *src1)
1269 if (src1 - src >= tmp_size)
1272 tmp_size = src1 - src + 256;
1273 tmp_buf = ir_tcl_malloc (tmp_size);
1275 memcpy (tmp_buf, src, src1 - src);
1276 tmp_buf[src1-src] = '\0';
1277 Tcl_SetVar (interp, argv[1], tmp_buf, 0);
1278 r = Tcl_Eval (interp, argv[3]);
1279 if (r != TCL_OK && r != TCL_CONTINUE)
1283 if (r == TCL_CONTINUE)
1289 /* --- R E G I S T R A T I O N ---------------------------------------- */
1291 * Waistcl_init: Registration of TCL commands.
1293 int Waistcl_Init (Tcl_Interp *interp)
1295 Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL,
1296 (Tcl_CmdDeleteProc *) NULL);
1297 Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk,
1298 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
1299 Tcl_CreateCommand (interp, "htmlToken", do_htmlToken,
1300 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);