2 * NWI - Nordic Web Index
3 * Technical Knowledge Centre & Library of Denmark (DTV)
5 * Wais extension to IrTcl
8 * Revision 1.4 1996-03-11 17:39:48 adam
9 * 40 documents are retrieved by default (maxDocs=40).
11 * Revision 1.3 1996/03/08 16:46:44 adam
12 * Doesn't use documentID to determine positions in present-response.
14 * Revision 1.2 1996/03/07 12:43:44 adam
15 * Better error handling. WAIS target closed before failback is invoked.
17 * Revision 1.1 1996/02/29 15:28:08 adam
18 * First version of Wais extension to IrTcl.
31 /* IrTcl internal header */
34 /* FreeWAIS-sf header */
47 typedef struct WaisTcl_Records {
48 WaisTcl_Record *record;
49 struct WaisTcl_Records *next;
66 IrTcl_SetObj *irtcl_set_obj;
68 WaisTcl_Records *records;
75 static void wais_obj_delete (ClientData clientData);
76 static void wais_select_notify (ClientData clientData, int r, int w, int e);
77 static int do_disconnect (void *obj, Tcl_Interp *interp,
78 int argc, char **argv);
80 /* --- N E T W O R K I / O ----------------------------------------- */
82 static void wais_select_write (ClientData clientData)
84 WaisTcl_Obj *p = clientData;
87 logf (LOG_DEBUG, "Wais write handler fd=%d", cs_fileno(p->wais_link));
88 switch (p->irtcl_obj->state)
90 case IR_TCL_R_Connecting:
91 logf(LOG_DEBUG, "write wais: connect");
92 r = cs_rcvconnect (p->wais_link);
95 p->irtcl_obj->state = IR_TCL_R_Idle;
98 logf (LOG_DEBUG, "cs_rcvconnect error");
99 do_disconnect (p, NULL, 2, NULL);
100 p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT;
101 if (p->irtcl_obj->failback)
102 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
105 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
106 clientData, 1, 0, 0);
107 if (p->irtcl_obj->callback)
108 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
110 case IR_TCL_R_Writing:
111 if ((r=cs_put (p->wais_link, p->buf_out, p->len_out)) < 0)
113 logf (LOG_DEBUG, "cs_put write fail");
114 do_disconnect (p, NULL, 2, NULL);
115 if (p->irtcl_obj->failback)
117 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
118 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
121 else if (r == 0) /* remove select bit */
123 logf(LOG_DEBUG, "Write completed");
124 p->irtcl_obj->state = IR_TCL_R_Waiting;
126 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
127 clientData, 1, 0, 0);
131 logf (LOG_FATAL|LOG_ERRNO, "Wais read. state=%d", p->irtcl_obj->state);
136 static WaisTcl_Record *wais_lookup_record_pos (WaisSetTcl_Obj *p, int pos)
138 WaisTcl_Records *recs;
140 for (recs = p->records; recs; recs = recs->next)
141 if (recs->record->position == pos)
146 static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos)
150 rec = wais_lookup_record_pos (p, pos);
155 if (rec->documentText ||
156 !p->irtcl_set_obj->recordElements ||
157 !*p->irtcl_set_obj->recordElements ||
158 strcmp (p->irtcl_set_obj->recordElements, "F"))
163 static void wais_delete_record (WaisTcl_Record *rec)
165 freeAny (rec->documentID);
166 free (rec->headline);
167 free (rec->documentText);
171 static void wais_delete_records (WaisSetTcl_Obj *p)
173 WaisTcl_Records *recs, *recs1;
175 for (recs = p->records; recs; recs = recs1)
178 wais_delete_record (recs->record);
184 static void wais_add_record_brief (WaisSetTcl_Obj *p,
193 WaisTcl_Records *recs;
195 rec = wais_lookup_record_pos (p, position);
198 rec = ir_tcl_malloc (sizeof(*rec));
200 recs = ir_tcl_malloc (sizeof(*recs));
202 recs->next = p->records;
207 freeAny (rec->documentID);
208 free (rec->headline);
209 if (rec->documentText)
210 free (rec->documentText);
212 rec->position = position;
213 rec->documentID = duplicateAny (documentID);
215 rec->documentLength = documentLength;
217 ir_tcl_strdup (NULL, &rec->headline, headline);
218 rec->documentText = NULL;
221 static void wais_add_record_full (WaisSetTcl_Obj *p,
226 rec = wais_lookup_record_pos (p, position);
230 logf (LOG_DEBUG, "Adding text. Didn't find corresponding brief");
233 if (rec->documentText)
234 free (rec->documentText);
235 rec->documentText = ir_tcl_malloc (documentText->size+1);
236 memcpy (rec->documentText, documentText->bytes, documentText->size);
237 rec->documentText[documentText->size] = '\0';
238 logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText);
241 static void wais_handle_search_response (WaisSetTcl_Obj *p,
242 SearchResponseAPDU *responseAPDU)
244 logf (LOG_DEBUG, "- SearchStatus=%d", responseAPDU->SearchStatus);
245 logf (LOG_DEBUG, "- ResultCount=%d", responseAPDU->ResultCount);
246 logf (LOG_DEBUG, "- NumberOfRecordsReturned=%d",
247 responseAPDU->NumberOfRecordsReturned);
248 logf (LOG_DEBUG, "- ResultSetStatus=%d", responseAPDU->ResultSetStatus);
249 logf (LOG_DEBUG, "- PresentStatus=%d", responseAPDU->PresentStatus);
251 if (responseAPDU->DatabaseDiagnosticRecords)
253 WAISSearchResponse *ddr = responseAPDU->DatabaseDiagnosticRecords;
255 p->irtcl_set_obj->searchStatus = 1;
257 p->irtcl_set_obj->nextResultSetPosition =
258 responseAPDU->NextResultSetPosition;
259 p->irtcl_set_obj->numberOfRecordsReturned =
260 responseAPDU->NumberOfRecordsReturned;
262 if (!p->irtcl_set_obj->resultCount)
265 if (responseAPDU->NumberOfRecordsReturned >
266 responseAPDU->ResultCount)
267 p->irtcl_set_obj->resultCount =
268 responseAPDU->NumberOfRecordsReturned;
271 p->irtcl_set_obj->resultCount =
272 responseAPDU->ResultCount;
274 logf (LOG_DEBUG, "resultCount=%d", p->irtcl_set_obj->resultCount);
279 if (ddr->Diagnostics)
281 diagnosticRecord **dr = ddr->Diagnostics;
284 logf (LOG_DEBUG, "Diagnostic response. %s : %s",
285 dr[0]->DIAG ? dr[0]->DIAG : "<null>",
286 dr[0]->ADDINFO ? dr[0]->ADDINFO : "<null>");
287 ir_tcl_strdup (NULL, &p->diag, dr[0]->DIAG);
288 ir_tcl_strdup (NULL, &p->addinfo, dr[0]->ADDINFO);
291 logf (LOG_DEBUG, "Diagnostic response");
296 logf (LOG_DEBUG, "Adding doc header entries");
297 for (i = 0; ddr->DocHeaders[i]; i++)
299 WAISDocumentHeader *head = ddr->DocHeaders[i];
301 logf (LOG_DEBUG, "%4d -->%.*s<--", i+1,
302 head->DocumentID->size, head->DocumentID->bytes);
303 wais_add_record_brief (p, i+1, head->DocumentID,
304 head->Score, head->DocumentLength,
305 head->Lines, head->Headline);
307 logf (LOG_DEBUG, "got %d DBOSD records", i);
312 logf (LOG_DEBUG, "Adding text entries");
313 for (i = 0; ddr->Text[i]; i++)
314 wais_add_record_full (p,
315 p->presentOffset + i,
316 ddr->Text[i]->DocumentText);
318 freeWAISSearchResponse (ddr);
322 logf (LOG_DEBUG, "No records!");
324 freeSearchResponseAPDU (responseAPDU);
328 static void wais_select_read (ClientData clientData)
330 SearchResponseAPDU *searchRAPDU;
331 ClientData objectClientData;
332 WaisTcl_Obj *p = clientData;
336 logf (LOG_DEBUG, "Wais read handler fd=%d", cs_fileno(p->wais_link));
339 /* signal one more use of ir object - callbacks must not
340 release the ir memory (p pointer) */
341 p->irtcl_obj->state = IR_TCL_R_Reading;
343 /* read incoming APDU */
344 if ((r=cs_get (p->wais_link, &p->irtcl_obj->buf_in,
345 &p->irtcl_obj->len_in)) <= 0)
348 logf (LOG_DEBUG, "cs_get failed, code %d", r);
349 do_disconnect (p, NULL, 2, NULL);
350 p->irtcl_obj->failInfo = IR_TCL_FAIL_READ;
351 if (p->irtcl_obj->failback)
352 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
353 /* release wais object now if callback deleted it */
359 logf(LOG_DEBUG, "PDU Fraction read");
362 logf (LOG_DEBUG, "cs_get ok, total size %d", r);
363 /* got complete APDU. Now decode */
366 /* determine set/ir object corresponding to response */
367 objectClientData = 0;
370 Tcl_CmdInfo cmd_info;
372 if (Tcl_GetCommandInfo (p->interp, p->object, &cmd_info))
373 objectClientData = cmd_info.clientData;
377 pdup = p->irtcl_obj->buf_in + HEADER_LENGTH;
378 switch (peekPDUType (pdup))
380 case initResponseAPDU:
381 p->irtcl_obj->eventType = "init";
382 logf (LOG_DEBUG, "Got Wais Init response");
384 case searchResponseAPDU:
385 p->irtcl_obj->eventType = "search";
386 logf (LOG_DEBUG, "Got Wais Search response");
388 readSearchResponseAPDU (&searchRAPDU, pdup);
391 logf (LOG_WARN, "Couldn't decode Wais search APDU",
393 p->irtcl_obj->failInfo = IR_TCL_FAIL_IN_APDU;
394 do_disconnect (p, NULL, 2, NULL);
395 if (p->irtcl_obj->failback)
396 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
400 if (objectClientData)
401 wais_handle_search_response (objectClientData, searchRAPDU);
404 logf (LOG_WARN, "Received unknown Wais APDU type %d",
406 do_disconnect (p, NULL, 2, NULL);
407 p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
408 if (p->irtcl_obj->failback)
409 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
413 p->irtcl_obj->state = IR_TCL_R_Idle;
415 if (p->irtcl_obj->callback)
416 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
417 if (p->ref_count == 1)
423 } while (p->wais_link && cs_more (p->wais_link));
426 static void wais_select_notify (ClientData clientData, int r, int w, int e)
429 wais_select_write (clientData);
431 wais_select_read (clientData);
434 static int wais_send_apdu (Tcl_Interp *interp, WaisTcl_Obj *p,
435 const char *msg, const char *object)
441 logf (LOG_DEBUG, "Cannot send. object=%s", p->object);
444 r = cs_put (p->wais_link, p->buf_out, p->len_out);
447 p->irtcl_obj->state = IR_TCL_R_Idle;
448 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
449 do_disconnect (p, NULL, 2, NULL);
450 if (p->irtcl_obj->failback)
452 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
457 interp->result = "Write failed when sending Wais PDU";
461 ir_tcl_strdup (NULL, &p->object, object);
464 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
466 logf (LOG_DEBUG, "Send part of wais %s APDU", msg);
467 p->irtcl_obj->state = IR_TCL_R_Writing;
471 logf (LOG_DEBUG, "Send %s (%d bytes) fd=%d", msg, p->len_out,
472 cs_fileno(p->wais_link));
473 p->irtcl_obj->state = IR_TCL_R_Waiting;
478 /* --- A S S O C I A T I O N S ----------------------------------------- */
480 static int do_connect (void *obj, Tcl_Interp *interp,
481 int argc, char **argv)
484 WaisTcl_Obj *p = obj;
491 Tcl_AppendResult (interp, p->hostname, NULL);
496 interp->result = "already connected";
499 if (strcmp (p->irtcl_obj->comstackType, "wais"))
501 interp->result = "only wais comstack supported";
504 p->wais_link = cs_create (tcpip_type, 0, PROTO_WAIS);
505 addr = tcpip_strtoaddr (argv[2]);
508 interp->result = "tcpip_strtoaddr fail";
511 logf (LOG_DEBUG, "tcp/ip wais connect %s", argv[2]);
513 if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
515 r = cs_connect (p->wais_link, addr);
516 logf(LOG_DEBUG, "cs_connect returned %d fd=%d", r,
517 cs_fileno(p->wais_link));
520 interp->result = "wais connect fail";
521 do_disconnect (p, NULL, 2, NULL);
524 p->irtcl_obj->eventType = "connect";
527 p->irtcl_obj->state = IR_TCL_R_Connecting;
528 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
533 p->irtcl_obj->state = IR_TCL_R_Idle;
534 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
536 if (p->irtcl_obj->callback)
537 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
542 static int do_disconnect (void *obj, Tcl_Interp *interp,
543 int argc, char **argv)
545 WaisTcl_Obj *p = obj;
556 ir_tcl_select_set (NULL, cs_fileno(p->wais_link), NULL, 0, 0, 0);
560 cs_close (p->wais_link);
568 static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv)
570 WaisTcl_Obj *p = obj;
574 p->irtcl_obj->initResult = 0;
577 interp->result = "not connected";
580 p->irtcl_obj->initResult = 1;
581 p->irtcl_obj->eventType = "init";
582 if (p->irtcl_obj->callback)
583 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
587 static int do_options (void *obj, Tcl_Interp *interp, int argc, char **argv)
589 WaisTcl_Obj *p = obj;
595 Tcl_AppendElement (p->interp, "search");
596 Tcl_AppendElement (p->interp, "present");
601 static IrTcl_Method wais_method_tab[] = {
602 { "connect", do_connect, NULL },
603 { "disconnect", do_disconnect, NULL },
604 { "init", do_init, NULL },
605 { "options", do_options, NULL },
610 int wais_obj_init(ClientData clientData, Tcl_Interp *interp,
611 int argc, char **argv, ClientData *subData,
612 ClientData parentData)
614 IrTcl_Methods tab[3];
621 interp->result = "wrong # args";
624 obj = ir_tcl_malloc (sizeof(*obj));
626 obj->interp = interp;
628 logf (LOG_DEBUG, "wais object create %s", argv[1]);
630 r = (*ir_obj_class.ir_init)(clientData, interp, argc, argv, &subP, 0);
633 obj->irtcl_obj = subP;
636 obj->buf_out = ir_tcl_malloc (obj->max_out);
638 free (obj->irtcl_obj->comstackType);
639 ir_tcl_strdup (NULL, &obj->irtcl_obj->comstackType, "wais");
641 tab[0].tab = wais_method_tab;
645 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
647 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
648 /* cleanup missing ... */
657 * wais_obj_delete: Wais Object disposal
659 static void wais_obj_delete (ClientData clientData)
661 WaisTcl_Obj *obj = clientData;
662 IrTcl_Methods tab[3];
665 if (obj->ref_count > 0)
668 logf (LOG_DEBUG, "wais object delete");
670 tab[0].tab = wais_method_tab;
674 ir_tcl_method (NULL, -1, NULL, tab, NULL);
676 (*ir_obj_class.ir_delete)((ClientData) obj->irtcl_obj);
683 * wais_obj_method: Wais Object methods
685 static int wais_obj_method (ClientData clientData, Tcl_Interp *interp,
686 int argc, char **argv)
688 IrTcl_Methods tab[3];
689 WaisTcl_Obj *p = clientData;
695 tab[0].tab = wais_method_tab;
699 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
701 return (*ir_obj_class.ir_method)((ClientData) p->irtcl_obj,
708 * wais_obj_mk: Wais Object creation
710 static int wais_obj_mk (ClientData clientData, Tcl_Interp *interp,
711 int argc, char **argv)
714 int r = wais_obj_init (clientData, interp, argc, argv, &subData, 0);
718 Tcl_CreateCommand (interp, argv[1], wais_obj_method,
719 subData, wais_obj_delete);
723 /* --- S E T S ---------------------------------------------------------- */
725 static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
727 WaisSetTcl_Obj *obj = o;
728 WaisTcl_Obj *p = obj->parent;
729 int i, start, number;
730 static char *element_names[3];
734 SearchAPDU *waisSearch;
742 if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
747 obj->presentOffset = start;
750 if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
757 interp->result = "present: not connected";
760 element_names[0] = " ";
761 element_names[1] = ES_DocumentText;
762 element_names[2] = NULL;
767 docObjs = ir_tcl_malloc (sizeof(*docObjs) * (number+1));
768 for (i = 0; i<number; i++)
772 rec = wais_lookup_record_pos (obj, i+start);
775 interp->result = "present request out of range";
778 docObjs[i] = makeDocObjUsingBytes (rec->documentID, "TEXT", 0,
779 rec->documentLength);
782 waisQuery = makeWAISTextQuery (docObjs);
784 makeSearchAPDU (30L, /* small */
787 (boolean) obj->irtcl_set_obj->
788 set_inher.replaceIndicator, /* replace indicator */
790 setName, /* result set name */
791 obj->irtcl_set_obj->set_inher.databaseNames,
792 QT_TextRetrievalQuery, /* query type */
793 element_names, /* element name */
794 &refID, /* reference ID */
798 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
799 p->len_out = p->max_out - left;
801 for (i = 0; i<number; i++)
802 CSTFreeDocObj (docObjs[i]);
805 CSTFreeWAISTextQuery (waisQuery);
806 freeSearchAPDU (waisSearch);
809 interp->result = "Couldn't encode Wais text search APDU";
812 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
813 (long) NO_COMPRESSION,
815 (long) HEADER_VERSION);
817 p->len_out += HEADER_LENGTH;
818 return wais_send_apdu (interp, p, "search", argv[0]);
821 static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
823 WaisSetTcl_Obj *obj = o;
824 WaisTcl_Obj *p = obj->parent;
825 WAISSearch *waisQuery;
826 SearchAPDU *waisSearch;
829 DocObj **docObjs = NULL;
833 if (argc < 3 || argc > 4)
835 interp->result = "wrong # args";
838 obj->presentOffset = 1;
841 docObjs = ir_tcl_malloc (2 * sizeof(*docObjs));
843 docObjs[0] = ir_tcl_malloc (sizeof(**docObjs));
844 docObjs[0]->DocumentID = stringToAny (argv[3]);
845 docObjs[0]->Type = NULL;
846 docObjs[0]->ChunkCode = (long) CT_document;
850 if (!obj->irtcl_set_obj->set_inher.num_databaseNames)
852 interp->result = "no databaseNames";
855 logf (LOG_DEBUG, "parent = %p", p);
858 interp->result = "not connected";
861 obj->irtcl_set_obj->resultCount = 0;
862 obj->irtcl_set_obj->searchStatus = 0;
864 makeWAISSearch (argv[2], /* seed words */
865 docObjs, /* doc ptrs */
867 1L, /* date factor */
868 0L, /* begin date range */
869 0L, /* end date range */
870 obj->maxDocs); /* max docs retrieved */
873 makeSearchAPDU (30L, /* small */
876 (boolean) obj->irtcl_set_obj->
877 set_inher.replaceIndicator, /* replace indicator */
879 setName, /* result set name */
880 obj->irtcl_set_obj->set_inher.databaseNames,
881 QT_RelevanceFeedbackQuery,
883 NULL, /* element name */
884 NULL, /* reference ID */
888 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
889 p->len_out = p->max_out - left;
891 CSTFreeWAISSearch (waisQuery);
892 freeSearchAPDU (waisSearch);
895 CSTFreeDocObj (docObjs[0]);
900 interp->result = "Couldn't encode Wais search APDU";
903 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
904 (long) NO_COMPRESSION,
906 (long) HEADER_VERSION);
908 p->len_out += HEADER_LENGTH;
909 return wais_send_apdu (interp, p, "search", argv[0]);
913 * do_responseStatus: Return response status (present or search)
915 static int do_responseStatus (void *o, Tcl_Interp *interp,
916 int argc, char **argv)
918 WaisSetTcl_Obj *obj = o;
933 Tcl_AppendElement (interp, "NSD");
935 Tcl_AppendElement (interp, obj->diag);
936 Tcl_AppendElement (interp, obj->diag);
938 Tcl_AppendElement (interp, obj->addinfo ? obj->addinfo : "");
941 Tcl_AppendElement (interp, "DBOSD");
946 * do_maxDocs: Set number of documents to be retrieved in ranked query
948 static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv)
950 WaisSetTcl_Obj *obj = o;
957 return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv);
962 * do_type: Return type (if any) at position.
964 static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
966 WaisSetTcl_Obj *obj = o;
977 wais_delete_records (obj);
982 sprintf (interp->result, "wrong # args");
985 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
987 rec = wais_lookup_record_pos_bf (obj, offset);
990 logf (LOG_DEBUG, "No record at position %d", offset);
993 interp->result = "DB";
999 * do_recordType: Return record type (if any) at position.
1001 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
1003 WaisSetTcl_Obj *obj = o;
1005 WaisTcl_Record *rec;
1013 sprintf (interp->result, "wrong # args");
1016 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1019 rec = wais_lookup_record_pos_bf (obj, offset);
1023 Tcl_AppendElement (interp, "WAIS");
1028 * do_getWAIS: Return WAIS record at position.
1030 static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv)
1032 WaisSetTcl_Obj *obj = o;
1034 WaisTcl_Record *rec;
1043 sprintf (interp->result, "wrong # args: should be"
1044 " \"assoc getWAIS pos field\"\n"
1045 " field is one of:\n"
1046 " score headline documentLength text lines documentID");
1049 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1051 rec = wais_lookup_record_pos_bf (obj, offset);
1054 if (!strcmp (argv[3], "score"))
1056 sprintf (prbuf, "%ld", (long) rec->score);
1057 Tcl_AppendElement (interp, prbuf);
1059 else if (!strcmp (argv[3], "headline"))
1061 Tcl_AppendElement (interp, rec->headline);
1063 else if (!strcmp (argv[3], "documentLength"))
1065 sprintf (prbuf, "%ld", (long) rec->documentLength);
1066 Tcl_AppendElement (interp, prbuf);
1068 else if (!strcmp (argv[3], "text"))
1070 Tcl_AppendElement (interp, rec->documentText);
1072 else if (!strcmp (argv[3], "lines"))
1074 sprintf (prbuf, "%ld", (long) rec->lines);
1075 Tcl_AppendElement (interp, prbuf);
1077 else if (!strcmp (argv[3], "documentID"))
1079 if (rec->documentID->size >= sizeof(prbuf))
1081 interp->result = "bad documentID";
1084 memcpy (prbuf, rec->documentID->bytes, rec->documentID->size);
1085 prbuf[rec->documentID->size] = '\0';
1086 Tcl_AppendElement (interp, prbuf);
1092 static IrTcl_Method wais_set_method_tab[] = {
1093 { "maxDocs", do_maxDocs, NULL },
1094 { "search", do_search, NULL },
1095 { "present", do_present, NULL },
1096 { "responseStatus", do_responseStatus, NULL },
1097 { "type", do_type, NULL },
1098 { "recordType", do_recordType, NULL },
1099 { "getWAIS", do_getWAIS, NULL },
1104 * wais_obj_method: Wais Set Object methods
1106 static int wais_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1107 int argc, char **argv)
1109 IrTcl_Methods tab[3];
1110 WaisSetTcl_Obj *p = clientData;
1116 tab[0].tab = wais_set_method_tab;
1120 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
1122 return (*ir_set_obj_class.ir_method)((ClientData) p->irtcl_set_obj,
1123 interp, argc, argv);
1128 int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp,
1129 int argc, char **argv, ClientData *subData,
1130 ClientData parentData)
1132 IrTcl_Methods tab[3];
1133 WaisSetTcl_Obj *obj;
1137 assert (parentData);
1140 obj = ir_tcl_malloc (sizeof(*obj));
1141 obj->parent = (WaisTcl_Obj *) parentData;
1142 logf (LOG_DEBUG, "parent = %p", obj->parent);
1143 obj->interp = interp;
1145 obj->addinfo = NULL;
1147 logf (LOG_DEBUG, "wais set object create %s", argv[1]);
1149 r = (*ir_set_obj_class.ir_init)(clientData, interp, argc, argv, &subP,
1150 obj->parent->irtcl_obj);
1153 obj->irtcl_set_obj = subP;
1155 tab[0].tab = wais_set_method_tab;
1159 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
1161 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
1162 /* cleanup missing ... */
1171 * wais_set_obj_delete: Wais Set Object disposal
1173 static void wais_set_obj_delete (ClientData clientData)
1175 WaisSetTcl_Obj *obj = clientData;
1176 IrTcl_Methods tab[3];
1178 logf (LOG_DEBUG, "wais set object delete");
1180 tab[0].tab = wais_set_method_tab;
1184 ir_tcl_method (NULL, -1, NULL, tab, NULL);
1186 (*ir_set_obj_class.ir_delete)((ClientData) obj->irtcl_set_obj);
1192 * wais_set_obj_mk: Wais Set Object creation
1194 static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1195 int argc, char **argv)
1199 Tcl_CmdInfo parent_info;
1203 interp->result = "wrong # args: should be"
1204 " \"wais-set set assoc?\"";
1207 parent_info.clientData = 0;
1208 if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
1210 interp->result = "No parent";
1213 r = wais_set_obj_init (clientData, interp, argc, argv, &subData,
1214 parent_info.clientData);
1217 Tcl_CreateCommand (interp, argv[1], wais_set_obj_method,
1218 subData, wais_set_obj_delete);
1226 int do_htmlToken (ClientData clientData, Tcl_Interp *interp,
1227 int argc, char **argv)
1230 char *tmp_buf = NULL;
1236 interp->result = "wrong # args: should be"
1237 " \"htmlToken var list command\"";
1245 if (*src == ' ' || *src == '\t' || *src == '\n' ||
1246 *src == '\r' || *src == '\f')
1254 while (*src1 != '>' && *src1 != '\n' ** src1)
1261 while (*src1 != '<' && *src1)
1264 if (src1 - src >= tmp_size)
1267 tmp_size = src1 - src + 256;
1268 tmp_buf = ir_tcl_malloc (tmp_size);
1270 memcpy (tmp_buf, src, src1 - src);
1271 tmp_buf[src1-src] = '\0';
1272 Tcl_SetVar (interp, argv[1], tmp_buf, 0);
1273 r = Tcl_Eval (interp, argv[3]);
1274 if (r != TCL_OK && r != TCL_CONTINUE)
1278 if (r == TCL_CONTINUE)
1284 /* --- R E G I S T R A T I O N ---------------------------------------- */
1286 * Waistcl_init: Registration of TCL commands.
1288 int Waistcl_Init (Tcl_Interp *interp)
1290 Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL,
1291 (Tcl_CmdDeleteProc *) NULL);
1292 Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk,
1293 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
1294 Tcl_CreateCommand (interp, "htmlToken", do_htmlToken,
1295 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);