2 * NWI - Nordic Web Index
3 * Technical Knowledge Centre & Library of Denmark (DTV)
5 * Wais extension to IrTcl
8 * Revision 1.5 1996-03-15 14:40:23 adam
9 * Bug fix: do_responseStatus called Tcl_AppendElement when interp was 0.
11 * Revision 1.4 1996/03/11 17:39:48 adam
12 * 40 documents are retrieved by default (maxDocs=40).
14 * Revision 1.3 1996/03/08 16:46:44 adam
15 * Doesn't use documentID to determine positions in present-response.
17 * Revision 1.2 1996/03/07 12:43:44 adam
18 * Better error handling. WAIS target closed before failback is invoked.
20 * Revision 1.1 1996/02/29 15:28:08 adam
21 * First version of Wais extension to IrTcl.
34 /* IrTcl internal header */
37 /* FreeWAIS-sf header */
50 typedef struct WaisTcl_Records {
51 WaisTcl_Record *record;
52 struct WaisTcl_Records *next;
69 IrTcl_SetObj *irtcl_set_obj;
71 WaisTcl_Records *records;
78 static void wais_obj_delete (ClientData clientData);
79 static void wais_select_notify (ClientData clientData, int r, int w, int e);
80 static int do_disconnect (void *obj, Tcl_Interp *interp,
81 int argc, char **argv);
83 /* --- N E T W O R K I / O ----------------------------------------- */
85 static void wais_select_write (ClientData clientData)
87 WaisTcl_Obj *p = clientData;
90 logf (LOG_DEBUG, "Wais write handler fd=%d", cs_fileno(p->wais_link));
91 switch (p->irtcl_obj->state)
93 case IR_TCL_R_Connecting:
94 logf(LOG_DEBUG, "write wais: connect");
95 r = cs_rcvconnect (p->wais_link);
98 p->irtcl_obj->state = IR_TCL_R_Idle;
101 logf (LOG_DEBUG, "cs_rcvconnect error");
102 do_disconnect (p, NULL, 2, NULL);
103 p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT;
104 if (p->irtcl_obj->failback)
105 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
108 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
109 clientData, 1, 0, 0);
110 if (p->irtcl_obj->callback)
111 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
113 case IR_TCL_R_Writing:
114 if ((r=cs_put (p->wais_link, p->buf_out, p->len_out)) < 0)
116 logf (LOG_DEBUG, "cs_put write fail");
117 do_disconnect (p, NULL, 2, NULL);
118 if (p->irtcl_obj->failback)
120 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
121 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
124 else if (r == 0) /* remove select bit */
126 logf(LOG_DEBUG, "Write completed");
127 p->irtcl_obj->state = IR_TCL_R_Waiting;
129 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
130 clientData, 1, 0, 0);
134 logf (LOG_FATAL|LOG_ERRNO, "Wais read. state=%d", p->irtcl_obj->state);
139 static WaisTcl_Record *wais_lookup_record_pos (WaisSetTcl_Obj *p, int pos)
141 WaisTcl_Records *recs;
143 for (recs = p->records; recs; recs = recs->next)
144 if (recs->record->position == pos)
149 static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos)
153 rec = wais_lookup_record_pos (p, pos);
158 if (rec->documentText ||
159 !p->irtcl_set_obj->recordElements ||
160 !*p->irtcl_set_obj->recordElements ||
161 strcmp (p->irtcl_set_obj->recordElements, "F"))
166 static void wais_delete_record (WaisTcl_Record *rec)
168 freeAny (rec->documentID);
169 free (rec->headline);
170 free (rec->documentText);
174 static void wais_delete_records (WaisSetTcl_Obj *p)
176 WaisTcl_Records *recs, *recs1;
178 for (recs = p->records; recs; recs = recs1)
181 wais_delete_record (recs->record);
187 static void wais_add_record_brief (WaisSetTcl_Obj *p,
196 WaisTcl_Records *recs;
198 rec = wais_lookup_record_pos (p, position);
201 rec = ir_tcl_malloc (sizeof(*rec));
203 recs = ir_tcl_malloc (sizeof(*recs));
205 recs->next = p->records;
210 freeAny (rec->documentID);
211 free (rec->headline);
212 if (rec->documentText)
213 free (rec->documentText);
215 rec->position = position;
216 rec->documentID = duplicateAny (documentID);
218 rec->documentLength = documentLength;
220 ir_tcl_strdup (NULL, &rec->headline, headline);
221 rec->documentText = NULL;
224 static void wais_add_record_full (WaisSetTcl_Obj *p,
229 rec = wais_lookup_record_pos (p, position);
233 logf (LOG_DEBUG, "Adding text. Didn't find corresponding brief");
236 if (rec->documentText)
237 free (rec->documentText);
238 rec->documentText = ir_tcl_malloc (documentText->size+1);
239 memcpy (rec->documentText, documentText->bytes, documentText->size);
240 rec->documentText[documentText->size] = '\0';
241 logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText);
244 static void wais_handle_search_response (WaisSetTcl_Obj *p,
245 SearchResponseAPDU *responseAPDU)
247 logf (LOG_DEBUG, "- SearchStatus=%d", responseAPDU->SearchStatus);
248 logf (LOG_DEBUG, "- ResultCount=%d", responseAPDU->ResultCount);
249 logf (LOG_DEBUG, "- NumberOfRecordsReturned=%d",
250 responseAPDU->NumberOfRecordsReturned);
251 logf (LOG_DEBUG, "- ResultSetStatus=%d", responseAPDU->ResultSetStatus);
252 logf (LOG_DEBUG, "- PresentStatus=%d", responseAPDU->PresentStatus);
254 if (responseAPDU->DatabaseDiagnosticRecords)
256 WAISSearchResponse *ddr = responseAPDU->DatabaseDiagnosticRecords;
258 p->irtcl_set_obj->searchStatus = 1;
260 p->irtcl_set_obj->nextResultSetPosition =
261 responseAPDU->NextResultSetPosition;
262 p->irtcl_set_obj->numberOfRecordsReturned =
263 responseAPDU->NumberOfRecordsReturned;
265 if (!p->irtcl_set_obj->resultCount)
268 if (responseAPDU->NumberOfRecordsReturned >
269 responseAPDU->ResultCount)
270 p->irtcl_set_obj->resultCount =
271 responseAPDU->NumberOfRecordsReturned;
274 p->irtcl_set_obj->resultCount =
275 responseAPDU->ResultCount;
277 logf (LOG_DEBUG, "resultCount=%d", p->irtcl_set_obj->resultCount);
282 if (ddr->Diagnostics)
284 diagnosticRecord **dr = ddr->Diagnostics;
287 logf (LOG_DEBUG, "Diagnostic response. %s : %s",
288 dr[0]->DIAG ? dr[0]->DIAG : "<null>",
289 dr[0]->ADDINFO ? dr[0]->ADDINFO : "<null>");
290 ir_tcl_strdup (NULL, &p->diag, dr[0]->DIAG);
291 ir_tcl_strdup (NULL, &p->addinfo, dr[0]->ADDINFO);
294 logf (LOG_DEBUG, "Diagnostic response");
299 logf (LOG_DEBUG, "Adding doc header entries");
300 for (i = 0; ddr->DocHeaders[i]; i++)
302 WAISDocumentHeader *head = ddr->DocHeaders[i];
304 logf (LOG_DEBUG, "%4d -->%.*s<--", i+1,
305 head->DocumentID->size, head->DocumentID->bytes);
306 wais_add_record_brief (p, i+1, head->DocumentID,
307 head->Score, head->DocumentLength,
308 head->Lines, head->Headline);
310 logf (LOG_DEBUG, "got %d DBOSD records", i);
315 logf (LOG_DEBUG, "Adding text entries");
316 for (i = 0; ddr->Text[i]; i++)
317 wais_add_record_full (p,
318 p->presentOffset + i,
319 ddr->Text[i]->DocumentText);
321 freeWAISSearchResponse (ddr);
325 logf (LOG_DEBUG, "No records!");
327 freeSearchResponseAPDU (responseAPDU);
331 static void wais_select_read (ClientData clientData)
333 SearchResponseAPDU *searchRAPDU;
334 ClientData objectClientData;
335 WaisTcl_Obj *p = clientData;
339 logf (LOG_DEBUG, "Wais read handler fd=%d", cs_fileno(p->wais_link));
342 /* signal one more use of ir object - callbacks must not
343 release the ir memory (p pointer) */
344 p->irtcl_obj->state = IR_TCL_R_Reading;
346 /* read incoming APDU */
347 if ((r=cs_get (p->wais_link, &p->irtcl_obj->buf_in,
348 &p->irtcl_obj->len_in)) <= 0)
351 logf (LOG_DEBUG, "cs_get failed, code %d", r);
352 do_disconnect (p, NULL, 2, NULL);
353 p->irtcl_obj->failInfo = IR_TCL_FAIL_READ;
354 if (p->irtcl_obj->failback)
355 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
356 /* release wais object now if callback deleted it */
362 logf(LOG_DEBUG, "PDU Fraction read");
365 logf (LOG_DEBUG, "cs_get ok, total size %d", r);
366 /* got complete APDU. Now decode */
369 /* determine set/ir object corresponding to response */
370 objectClientData = 0;
373 Tcl_CmdInfo cmd_info;
375 if (Tcl_GetCommandInfo (p->interp, p->object, &cmd_info))
376 objectClientData = cmd_info.clientData;
380 pdup = p->irtcl_obj->buf_in + HEADER_LENGTH;
381 switch (peekPDUType (pdup))
383 case initResponseAPDU:
384 p->irtcl_obj->eventType = "init";
385 logf (LOG_DEBUG, "Got Wais Init response");
387 case searchResponseAPDU:
388 p->irtcl_obj->eventType = "search";
389 logf (LOG_DEBUG, "Got Wais Search response");
391 readSearchResponseAPDU (&searchRAPDU, pdup);
394 logf (LOG_WARN, "Couldn't decode Wais search APDU",
396 p->irtcl_obj->failInfo = IR_TCL_FAIL_IN_APDU;
397 do_disconnect (p, NULL, 2, NULL);
398 if (p->irtcl_obj->failback)
399 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
403 if (objectClientData)
404 wais_handle_search_response (objectClientData, searchRAPDU);
407 logf (LOG_WARN, "Received unknown Wais APDU type %d",
409 do_disconnect (p, NULL, 2, NULL);
410 p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
411 if (p->irtcl_obj->failback)
412 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
416 p->irtcl_obj->state = IR_TCL_R_Idle;
418 if (p->irtcl_obj->callback)
419 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
420 if (p->ref_count == 1)
426 } while (p->wais_link && cs_more (p->wais_link));
429 static void wais_select_notify (ClientData clientData, int r, int w, int e)
432 wais_select_write (clientData);
434 wais_select_read (clientData);
437 static int wais_send_apdu (Tcl_Interp *interp, WaisTcl_Obj *p,
438 const char *msg, const char *object)
444 logf (LOG_DEBUG, "Cannot send. object=%s", p->object);
447 r = cs_put (p->wais_link, p->buf_out, p->len_out);
450 p->irtcl_obj->state = IR_TCL_R_Idle;
451 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
452 do_disconnect (p, NULL, 2, NULL);
453 if (p->irtcl_obj->failback)
455 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
460 interp->result = "Write failed when sending Wais PDU";
464 ir_tcl_strdup (NULL, &p->object, object);
467 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
469 logf (LOG_DEBUG, "Send part of wais %s APDU", msg);
470 p->irtcl_obj->state = IR_TCL_R_Writing;
474 logf (LOG_DEBUG, "Send %s (%d bytes) fd=%d", msg, p->len_out,
475 cs_fileno(p->wais_link));
476 p->irtcl_obj->state = IR_TCL_R_Waiting;
481 /* --- A S S O C I A T I O N S ----------------------------------------- */
483 static int do_connect (void *obj, Tcl_Interp *interp,
484 int argc, char **argv)
487 WaisTcl_Obj *p = obj;
494 Tcl_AppendResult (interp, p->hostname, NULL);
499 interp->result = "already connected";
502 if (strcmp (p->irtcl_obj->comstackType, "wais"))
504 interp->result = "only wais comstack supported";
507 p->wais_link = cs_create (tcpip_type, 0, PROTO_WAIS);
508 addr = tcpip_strtoaddr (argv[2]);
511 interp->result = "tcpip_strtoaddr fail";
514 logf (LOG_DEBUG, "tcp/ip wais connect %s", argv[2]);
516 if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
518 r = cs_connect (p->wais_link, addr);
519 logf(LOG_DEBUG, "cs_connect returned %d fd=%d", r,
520 cs_fileno(p->wais_link));
523 interp->result = "wais connect fail";
524 do_disconnect (p, NULL, 2, NULL);
527 p->irtcl_obj->eventType = "connect";
530 p->irtcl_obj->state = IR_TCL_R_Connecting;
531 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
536 p->irtcl_obj->state = IR_TCL_R_Idle;
537 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
539 if (p->irtcl_obj->callback)
540 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
545 static int do_disconnect (void *obj, Tcl_Interp *interp,
546 int argc, char **argv)
548 WaisTcl_Obj *p = obj;
559 ir_tcl_select_set (NULL, cs_fileno(p->wais_link), NULL, 0, 0, 0);
563 cs_close (p->wais_link);
571 static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv)
573 WaisTcl_Obj *p = obj;
577 p->irtcl_obj->initResult = 0;
580 interp->result = "not connected";
583 p->irtcl_obj->initResult = 1;
584 p->irtcl_obj->eventType = "init";
585 if (p->irtcl_obj->callback)
586 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
590 static int do_options (void *obj, Tcl_Interp *interp, int argc, char **argv)
592 WaisTcl_Obj *p = obj;
598 Tcl_AppendElement (p->interp, "search");
599 Tcl_AppendElement (p->interp, "present");
604 static IrTcl_Method wais_method_tab[] = {
605 { "connect", do_connect, NULL },
606 { "disconnect", do_disconnect, NULL },
607 { "init", do_init, NULL },
608 { "options", do_options, NULL },
613 int wais_obj_init(ClientData clientData, Tcl_Interp *interp,
614 int argc, char **argv, ClientData *subData,
615 ClientData parentData)
617 IrTcl_Methods tab[3];
624 interp->result = "wrong # args";
627 obj = ir_tcl_malloc (sizeof(*obj));
629 obj->interp = interp;
631 logf (LOG_DEBUG, "wais object create %s", argv[1]);
633 r = (*ir_obj_class.ir_init)(clientData, interp, argc, argv, &subP, 0);
636 obj->irtcl_obj = subP;
639 obj->buf_out = ir_tcl_malloc (obj->max_out);
641 free (obj->irtcl_obj->comstackType);
642 ir_tcl_strdup (NULL, &obj->irtcl_obj->comstackType, "wais");
644 tab[0].tab = wais_method_tab;
648 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
650 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
651 /* cleanup missing ... */
660 * wais_obj_delete: Wais Object disposal
662 static void wais_obj_delete (ClientData clientData)
664 WaisTcl_Obj *obj = clientData;
665 IrTcl_Methods tab[3];
668 if (obj->ref_count > 0)
671 logf (LOG_DEBUG, "wais object delete");
673 tab[0].tab = wais_method_tab;
677 ir_tcl_method (NULL, -1, NULL, tab, NULL);
679 (*ir_obj_class.ir_delete)((ClientData) obj->irtcl_obj);
686 * wais_obj_method: Wais Object methods
688 static int wais_obj_method (ClientData clientData, Tcl_Interp *interp,
689 int argc, char **argv)
691 IrTcl_Methods tab[3];
692 WaisTcl_Obj *p = clientData;
698 tab[0].tab = wais_method_tab;
702 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
704 return (*ir_obj_class.ir_method)((ClientData) p->irtcl_obj,
711 * wais_obj_mk: Wais Object creation
713 static int wais_obj_mk (ClientData clientData, Tcl_Interp *interp,
714 int argc, char **argv)
717 int r = wais_obj_init (clientData, interp, argc, argv, &subData, 0);
721 Tcl_CreateCommand (interp, argv[1], wais_obj_method,
722 subData, wais_obj_delete);
726 /* --- S E T S ---------------------------------------------------------- */
728 static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
730 WaisSetTcl_Obj *obj = o;
731 WaisTcl_Obj *p = obj->parent;
732 int i, start, number;
733 static char *element_names[3];
737 SearchAPDU *waisSearch;
745 if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
750 obj->presentOffset = start;
753 if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
760 interp->result = "present: not connected";
763 element_names[0] = " ";
764 element_names[1] = ES_DocumentText;
765 element_names[2] = NULL;
770 docObjs = ir_tcl_malloc (sizeof(*docObjs) * (number+1));
771 for (i = 0; i<number; i++)
775 rec = wais_lookup_record_pos (obj, i+start);
778 interp->result = "present request out of range";
781 docObjs[i] = makeDocObjUsingBytes (rec->documentID, "TEXT", 0,
782 rec->documentLength);
785 waisQuery = makeWAISTextQuery (docObjs);
787 makeSearchAPDU (30L, /* small */
790 (boolean) obj->irtcl_set_obj->
791 set_inher.replaceIndicator, /* replace indicator */
793 setName, /* result set name */
794 obj->irtcl_set_obj->set_inher.databaseNames,
795 QT_TextRetrievalQuery, /* query type */
796 element_names, /* element name */
797 &refID, /* reference ID */
801 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
802 p->len_out = p->max_out - left;
804 for (i = 0; i<number; i++)
805 CSTFreeDocObj (docObjs[i]);
808 CSTFreeWAISTextQuery (waisQuery);
809 freeSearchAPDU (waisSearch);
812 interp->result = "Couldn't encode Wais text search APDU";
815 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
816 (long) NO_COMPRESSION,
818 (long) HEADER_VERSION);
820 p->len_out += HEADER_LENGTH;
821 return wais_send_apdu (interp, p, "search", argv[0]);
824 static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
826 WaisSetTcl_Obj *obj = o;
827 WaisTcl_Obj *p = obj->parent;
828 WAISSearch *waisQuery;
829 SearchAPDU *waisSearch;
832 DocObj **docObjs = NULL;
836 if (argc < 3 || argc > 4)
838 interp->result = "wrong # args";
841 obj->presentOffset = 1;
844 docObjs = ir_tcl_malloc (2 * sizeof(*docObjs));
846 docObjs[0] = ir_tcl_malloc (sizeof(**docObjs));
847 docObjs[0]->DocumentID = stringToAny (argv[3]);
848 docObjs[0]->Type = NULL;
849 docObjs[0]->ChunkCode = (long) CT_document;
853 if (!obj->irtcl_set_obj->set_inher.num_databaseNames)
855 interp->result = "no databaseNames";
858 logf (LOG_DEBUG, "parent = %p", p);
861 interp->result = "not connected";
864 obj->irtcl_set_obj->resultCount = 0;
865 obj->irtcl_set_obj->searchStatus = 0;
867 makeWAISSearch (argv[2], /* seed words */
868 docObjs, /* doc ptrs */
870 1L, /* date factor */
871 0L, /* begin date range */
872 0L, /* end date range */
873 obj->maxDocs); /* max docs retrieved */
876 makeSearchAPDU (30L, /* small */
879 (boolean) obj->irtcl_set_obj->
880 set_inher.replaceIndicator, /* replace indicator */
882 setName, /* result set name */
883 obj->irtcl_set_obj->set_inher.databaseNames,
884 QT_RelevanceFeedbackQuery,
886 NULL, /* element name */
887 NULL, /* reference ID */
891 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
892 p->len_out = p->max_out - left;
894 CSTFreeWAISSearch (waisQuery);
895 freeSearchAPDU (waisSearch);
898 CSTFreeDocObj (docObjs[0]);
903 interp->result = "Couldn't encode Wais search APDU";
906 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
907 (long) NO_COMPRESSION,
909 (long) HEADER_VERSION);
911 p->len_out += HEADER_LENGTH;
912 return wais_send_apdu (interp, p, "search", argv[0]);
916 * do_responseStatus: Return response status (present or search)
918 static int do_responseStatus (void *o, Tcl_Interp *interp,
919 int argc, char **argv)
921 WaisSetTcl_Obj *obj = o;
937 Tcl_AppendElement (interp, "NSD");
939 Tcl_AppendElement (interp, obj->diag);
940 Tcl_AppendElement (interp, obj->diag);
942 Tcl_AppendElement (interp, obj->addinfo ? obj->addinfo : "");
945 Tcl_AppendElement (interp, "DBOSD");
950 * do_maxDocs: Set number of documents to be retrieved in ranked query
952 static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv)
954 WaisSetTcl_Obj *obj = o;
961 return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv);
966 * do_type: Return type (if any) at position.
968 static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
970 WaisSetTcl_Obj *obj = o;
981 wais_delete_records (obj);
986 sprintf (interp->result, "wrong # args");
989 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
991 rec = wais_lookup_record_pos_bf (obj, offset);
994 logf (LOG_DEBUG, "No record at position %d", offset);
997 interp->result = "DB";
1003 * do_recordType: Return record type (if any) at position.
1005 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
1007 WaisSetTcl_Obj *obj = o;
1009 WaisTcl_Record *rec;
1017 sprintf (interp->result, "wrong # args");
1020 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1023 rec = wais_lookup_record_pos_bf (obj, offset);
1027 Tcl_AppendElement (interp, "WAIS");
1032 * do_getWAIS: Return WAIS record at position.
1034 static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv)
1036 WaisSetTcl_Obj *obj = o;
1038 WaisTcl_Record *rec;
1047 sprintf (interp->result, "wrong # args: should be"
1048 " \"assoc getWAIS pos field\"\n"
1049 " field is one of:\n"
1050 " score headline documentLength text lines documentID");
1053 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1055 rec = wais_lookup_record_pos_bf (obj, offset);
1058 if (!strcmp (argv[3], "score"))
1060 sprintf (prbuf, "%ld", (long) rec->score);
1061 Tcl_AppendElement (interp, prbuf);
1063 else if (!strcmp (argv[3], "headline"))
1065 Tcl_AppendElement (interp, rec->headline);
1067 else if (!strcmp (argv[3], "documentLength"))
1069 sprintf (prbuf, "%ld", (long) rec->documentLength);
1070 Tcl_AppendElement (interp, prbuf);
1072 else if (!strcmp (argv[3], "text"))
1074 Tcl_AppendElement (interp, rec->documentText);
1076 else if (!strcmp (argv[3], "lines"))
1078 sprintf (prbuf, "%ld", (long) rec->lines);
1079 Tcl_AppendElement (interp, prbuf);
1081 else if (!strcmp (argv[3], "documentID"))
1083 if (rec->documentID->size >= sizeof(prbuf))
1085 interp->result = "bad documentID";
1088 memcpy (prbuf, rec->documentID->bytes, rec->documentID->size);
1089 prbuf[rec->documentID->size] = '\0';
1090 Tcl_AppendElement (interp, prbuf);
1096 static IrTcl_Method wais_set_method_tab[] = {
1097 { "maxDocs", do_maxDocs, NULL },
1098 { "search", do_search, NULL },
1099 { "present", do_present, NULL },
1100 { "responseStatus", do_responseStatus, NULL },
1101 { "type", do_type, NULL },
1102 { "recordType", do_recordType, NULL },
1103 { "getWAIS", do_getWAIS, NULL },
1108 * wais_obj_method: Wais Set Object methods
1110 static int wais_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1111 int argc, char **argv)
1113 IrTcl_Methods tab[3];
1114 WaisSetTcl_Obj *p = clientData;
1120 tab[0].tab = wais_set_method_tab;
1124 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
1126 return (*ir_set_obj_class.ir_method)((ClientData) p->irtcl_set_obj,
1127 interp, argc, argv);
1132 int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp,
1133 int argc, char **argv, ClientData *subData,
1134 ClientData parentData)
1136 IrTcl_Methods tab[3];
1137 WaisSetTcl_Obj *obj;
1141 assert (parentData);
1144 obj = ir_tcl_malloc (sizeof(*obj));
1145 obj->parent = (WaisTcl_Obj *) parentData;
1146 logf (LOG_DEBUG, "parent = %p", obj->parent);
1147 obj->interp = interp;
1149 obj->addinfo = NULL;
1151 logf (LOG_DEBUG, "wais set object create %s", argv[1]);
1153 r = (*ir_set_obj_class.ir_init)(clientData, interp, argc, argv, &subP,
1154 obj->parent->irtcl_obj);
1157 obj->irtcl_set_obj = subP;
1159 tab[0].tab = wais_set_method_tab;
1163 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
1165 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
1166 /* cleanup missing ... */
1175 * wais_set_obj_delete: Wais Set Object disposal
1177 static void wais_set_obj_delete (ClientData clientData)
1179 WaisSetTcl_Obj *obj = clientData;
1180 IrTcl_Methods tab[3];
1182 logf (LOG_DEBUG, "wais set object delete");
1184 tab[0].tab = wais_set_method_tab;
1188 ir_tcl_method (NULL, -1, NULL, tab, NULL);
1190 (*ir_set_obj_class.ir_delete)((ClientData) obj->irtcl_set_obj);
1196 * wais_set_obj_mk: Wais Set Object creation
1198 static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1199 int argc, char **argv)
1203 Tcl_CmdInfo parent_info;
1207 interp->result = "wrong # args: should be"
1208 " \"wais-set set assoc?\"";
1211 parent_info.clientData = 0;
1212 if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
1214 interp->result = "No parent";
1217 r = wais_set_obj_init (clientData, interp, argc, argv, &subData,
1218 parent_info.clientData);
1221 Tcl_CreateCommand (interp, argv[1], wais_set_obj_method,
1222 subData, wais_set_obj_delete);
1230 int do_htmlToken (ClientData clientData, Tcl_Interp *interp,
1231 int argc, char **argv)
1234 char *tmp_buf = NULL;
1240 interp->result = "wrong # args: should be"
1241 " \"htmlToken var list command\"";
1249 if (*src == ' ' || *src == '\t' || *src == '\n' ||
1250 *src == '\r' || *src == '\f')
1258 while (*src1 != '>' && *src1 != '\n' ** src1)
1265 while (*src1 != '<' && *src1)
1268 if (src1 - src >= tmp_size)
1271 tmp_size = src1 - src + 256;
1272 tmp_buf = ir_tcl_malloc (tmp_size);
1274 memcpy (tmp_buf, src, src1 - src);
1275 tmp_buf[src1-src] = '\0';
1276 Tcl_SetVar (interp, argv[1], tmp_buf, 0);
1277 r = Tcl_Eval (interp, argv[3]);
1278 if (r != TCL_OK && r != TCL_CONTINUE)
1282 if (r == TCL_CONTINUE)
1288 /* --- R E G I S T R A T I O N ---------------------------------------- */
1290 * Waistcl_init: Registration of TCL commands.
1292 int Waistcl_Init (Tcl_Interp *interp)
1294 Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL,
1295 (Tcl_CmdDeleteProc *) NULL);
1296 Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk,
1297 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
1298 Tcl_CreateCommand (interp, "htmlToken", do_htmlToken,
1299 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);