2 * NWI - Nordic Web Index
3 * Technical Knowledge Centre & Library of Denmark (DTV)
5 * Wais extension to IrTcl
8 * Revision 1.2 1996-03-07 12:43:44 adam
9 * Better error handling. WAIS target closed before failback is invoked.
11 * Revision 1.1 1996/02/29 15:28:08 adam
12 * First version of Wais extension to IrTcl.
25 /* IrTcl internal header */
28 /* FreeWAIS-sf header */
41 typedef struct WaisTcl_Records {
42 WaisTcl_Record *record;
43 struct WaisTcl_Records *next;
60 IrTcl_SetObj *irtcl_set_obj;
62 WaisTcl_Records *records;
68 static void wais_obj_delete (ClientData clientData);
69 static void wais_select_notify (ClientData clientData, int r, int w, int e);
70 static int do_disconnect (void *obj, Tcl_Interp *interp,
71 int argc, char **argv);
73 /* --- N E T W O R K I / O ----------------------------------------- */
75 static void wais_select_write (ClientData clientData)
77 WaisTcl_Obj *p = clientData;
80 logf (LOG_DEBUG, "Wais write handler fd=%d", cs_fileno(p->wais_link));
81 switch (p->irtcl_obj->state)
83 case IR_TCL_R_Connecting:
84 logf(LOG_DEBUG, "write wais: connect");
85 r = cs_rcvconnect (p->wais_link);
88 p->irtcl_obj->state = IR_TCL_R_Idle;
91 logf (LOG_DEBUG, "cs_rcvconnect error");
92 do_disconnect (p, NULL, 2, NULL);
93 p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT;
94 if (p->irtcl_obj->failback)
95 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
98 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
100 if (p->irtcl_obj->callback)
101 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
103 case IR_TCL_R_Writing:
104 if ((r=cs_put (p->wais_link, p->buf_out, p->len_out)) < 0)
106 logf (LOG_DEBUG, "cs_put write fail");
107 do_disconnect (p, NULL, 2, NULL);
108 if (p->irtcl_obj->failback)
110 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
111 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
114 else if (r == 0) /* remove select bit */
116 logf(LOG_DEBUG, "Write completed");
117 p->irtcl_obj->state = IR_TCL_R_Waiting;
119 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
120 clientData, 1, 0, 0);
124 logf (LOG_FATAL|LOG_ERRNO, "Wais read. state=%d", p->irtcl_obj->state);
129 static WaisTcl_Record *wais_lookup_record_pos (WaisSetTcl_Obj *p, int pos)
131 WaisTcl_Records *recs;
133 for (recs = p->records; recs; recs = recs->next)
134 if (recs->record->position == pos)
139 static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos)
143 rec = wais_lookup_record_pos (p, pos);
148 if (rec->documentText ||
149 !p->irtcl_set_obj->recordElements ||
150 !*p->irtcl_set_obj->recordElements ||
151 strcmp (p->irtcl_set_obj->recordElements, "F"))
156 static WaisTcl_Record *wais_lookup_record_id (WaisSetTcl_Obj *p, any *id)
158 WaisTcl_Records *recs;
160 for (recs = p->records; recs; recs = recs->next)
161 if (recs->record->documentID->size == id->size &&
162 !memcmp (recs->record->documentID->bytes, id->bytes, id->size))
167 static void wais_delete_record (WaisTcl_Record *rec)
169 freeAny (rec->documentID);
170 free (rec->headline);
171 free (rec->documentText);
175 static void wais_delete_records (WaisSetTcl_Obj *p)
177 WaisTcl_Records *recs, *recs1;
179 for (recs = p->records; recs; recs = recs1)
182 wais_delete_record (recs->record);
188 static void wais_add_record_brief (WaisSetTcl_Obj *p,
197 WaisTcl_Records *recs;
199 rec = wais_lookup_record_pos (p, position);
202 rec = ir_tcl_malloc (sizeof(*rec));
204 recs = ir_tcl_malloc (sizeof(*recs));
206 recs->next = p->records;
211 freeAny (rec->documentID);
212 free (rec->headline);
213 if (rec->documentText)
214 free (rec->documentText);
216 rec->position = position;
217 rec->documentID = duplicateAny (documentID);
219 rec->documentLength = documentLength;
221 ir_tcl_strdup (NULL, &rec->headline, headline);
222 rec->documentText = NULL;
225 static void wais_add_record_full (WaisSetTcl_Obj *p,
230 rec = wais_lookup_record_id (p, documentID);
234 logf (LOG_DEBUG, "Adding text. Didn't find corresponding brief");
237 if (rec->documentText)
238 free (rec->documentText);
239 rec->documentText = ir_tcl_malloc (documentText->size+1);
240 memcpy (rec->documentText, documentText->bytes, documentText->size);
241 rec->documentText[documentText->size] = '\0';
242 logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText);
245 static void wais_handle_search_response (WaisSetTcl_Obj *p,
246 SearchResponseAPDU *responseAPDU)
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)
261 if (responseAPDU->NumberOfRecordsReturned >
262 responseAPDU->ResultCount)
263 p->irtcl_set_obj->resultCount =
264 responseAPDU->NumberOfRecordsReturned;
266 p->irtcl_set_obj->resultCount =
267 responseAPDU->ResultCount;
273 if (ddr->Diagnostics)
275 diagnosticRecord **dr = ddr->Diagnostics;
278 logf (LOG_DEBUG, "Diagnostic response. %s : %s",
279 dr[0]->DIAG ? dr[0]->DIAG : "<null>",
280 dr[0]->ADDINFO ? dr[0]->ADDINFO : "<null>");
281 ir_tcl_strdup (NULL, &p->diag, dr[0]->DIAG);
282 ir_tcl_strdup (NULL, &p->addinfo, dr[0]->ADDINFO);
285 logf (LOG_DEBUG, "Diagnostic response");
290 logf (LOG_DEBUG, "Adding doc header entries");
291 for (i = 0; ddr->DocHeaders[i]; i++)
293 WAISDocumentHeader *head = ddr->DocHeaders[i];
295 logf (LOG_DEBUG, "%4d -->%.*s<--", i+1,
296 head->DocumentID->size, head->DocumentID->bytes);
297 wais_add_record_brief (p, i+1, head->DocumentID,
298 head->Score, head->DocumentLength,
299 head->Lines, head->Headline);
301 logf (LOG_DEBUG, "got %d DBOSD records", i);
306 logf (LOG_DEBUG, "Adding text entries");
307 for (i = 0; ddr->Text[i]; i++)
309 logf (LOG_DEBUG, " -->%.*s<--",
310 ddr->Text[i]->DocumentID->size,
311 ddr->Text[i]->DocumentID->bytes);
312 wais_add_record_full (p,
313 ddr->Text[i]->DocumentID,
314 ddr->Text[i]->DocumentText);
317 freeWAISSearchResponse (ddr);
321 logf (LOG_DEBUG, "No records!");
323 freeSearchResponseAPDU (responseAPDU);
327 static void wais_select_read (ClientData clientData)
329 SearchResponseAPDU *searchRAPDU;
330 ClientData objectClientData;
331 WaisTcl_Obj *p = clientData;
335 logf (LOG_DEBUG, "Wais read handler fd=%d", cs_fileno(p->wais_link));
338 /* signal one more use of ir object - callbacks must not
339 release the ir memory (p pointer) */
340 p->irtcl_obj->state = IR_TCL_R_Reading;
342 /* read incoming APDU */
343 if ((r=cs_get (p->wais_link, &p->irtcl_obj->buf_in,
344 &p->irtcl_obj->len_in)) <= 0)
347 logf (LOG_DEBUG, "cs_get failed, code %d", r);
348 do_disconnect (p, NULL, 2, NULL);
349 p->irtcl_obj->failInfo = IR_TCL_FAIL_READ;
350 if (p->irtcl_obj->failback)
351 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
352 /* release wais object now if callback deleted it */
358 logf(LOG_DEBUG, "PDU Fraction read");
361 logf (LOG_DEBUG, "cs_get ok, total size %d", r);
362 /* got complete APDU. Now decode */
365 /* determine set/ir object corresponding to response */
366 objectClientData = 0;
369 Tcl_CmdInfo cmd_info;
371 if (Tcl_GetCommandInfo (p->interp, p->object, &cmd_info))
372 objectClientData = cmd_info.clientData;
376 pdup = p->irtcl_obj->buf_in + HEADER_LENGTH;
377 switch (peekPDUType (pdup))
379 case initResponseAPDU:
380 p->irtcl_obj->eventType = "init";
381 logf (LOG_DEBUG, "Got Wais Init response");
383 case searchResponseAPDU:
384 p->irtcl_obj->eventType = "search";
385 logf (LOG_DEBUG, "Got Wais Search response");
387 readSearchResponseAPDU (&searchRAPDU, pdup);
390 logf (LOG_WARN, "Couldn't decode Wais search APDU",
392 p->irtcl_obj->failInfo = IR_TCL_FAIL_IN_APDU;
393 do_disconnect (p, NULL, 2, NULL);
394 if (p->irtcl_obj->failback)
395 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
399 if (objectClientData)
400 wais_handle_search_response (objectClientData, searchRAPDU);
403 logf (LOG_WARN, "Received unknown Wais APDU type %d",
405 do_disconnect (p, NULL, 2, NULL);
406 p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
407 if (p->irtcl_obj->failback)
408 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
412 p->irtcl_obj->state = IR_TCL_R_Idle;
414 if (p->irtcl_obj->callback)
415 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
416 if (p->ref_count == 1)
422 } while (p->wais_link && cs_more (p->wais_link));
425 static void wais_select_notify (ClientData clientData, int r, int w, int e)
428 wais_select_write (clientData);
430 wais_select_read (clientData);
433 static int wais_send_apdu (Tcl_Interp *interp, WaisTcl_Obj *p,
434 const char *msg, const char *object)
440 logf (LOG_DEBUG, "Cannot send. object=%s", p->object);
443 r = cs_put (p->wais_link, p->buf_out, p->len_out);
446 p->irtcl_obj->state = IR_TCL_R_Idle;
447 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
448 do_disconnect (p, NULL, 2, NULL);
449 if (p->irtcl_obj->failback)
451 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
456 interp->result = "Write failed when sending Wais PDU";
460 ir_tcl_strdup (NULL, &p->object, object);
463 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
465 logf (LOG_DEBUG, "Send part of wais %s APDU", msg);
466 p->irtcl_obj->state = IR_TCL_R_Writing;
470 logf (LOG_DEBUG, "Send %s (%d bytes) fd=%d", msg, p->len_out,
471 cs_fileno(p->wais_link));
472 p->irtcl_obj->state = IR_TCL_R_Waiting;
477 /* --- A S S O C I A T I O N S ----------------------------------------- */
479 static int do_connect (void *obj, Tcl_Interp *interp,
480 int argc, char **argv)
483 WaisTcl_Obj *p = obj;
490 Tcl_AppendResult (interp, p->hostname, NULL);
495 interp->result = "already connected";
498 if (strcmp (p->irtcl_obj->comstackType, "wais"))
500 interp->result = "only wais comstack supported";
503 p->wais_link = cs_create (tcpip_type, 0, PROTO_WAIS);
504 addr = tcpip_strtoaddr (argv[2]);
507 interp->result = "tcpip_strtoaddr fail";
510 logf (LOG_DEBUG, "tcp/ip wais connect %s", argv[2]);
512 if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
514 r = cs_connect (p->wais_link, addr);
515 logf(LOG_DEBUG, "cs_connect returned %d fd=%d", r,
516 cs_fileno(p->wais_link));
519 interp->result = "wais connect fail";
520 do_disconnect (p, NULL, 2, NULL);
523 p->irtcl_obj->eventType = "connect";
526 p->irtcl_obj->state = IR_TCL_R_Connecting;
527 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
532 p->irtcl_obj->state = IR_TCL_R_Idle;
533 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
535 if (p->irtcl_obj->callback)
536 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
541 static int do_disconnect (void *obj, Tcl_Interp *interp,
542 int argc, char **argv)
544 WaisTcl_Obj *p = obj;
555 ir_tcl_select_set (NULL, cs_fileno(p->wais_link), NULL, 0, 0, 0);
559 cs_close (p->wais_link);
567 static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv)
569 WaisTcl_Obj *p = obj;
573 p->irtcl_obj->initResult = 0;
576 interp->result = "not connected";
579 p->irtcl_obj->initResult = 1;
580 p->irtcl_obj->eventType = "init";
581 if (p->irtcl_obj->callback)
582 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
586 static int do_options (void *obj, Tcl_Interp *interp, int argc, char **argv)
588 WaisTcl_Obj *p = obj;
594 Tcl_AppendElement (p->interp, "search");
595 Tcl_AppendElement (p->interp, "present");
600 static IrTcl_Method wais_method_tab[] = {
601 { "connect", do_connect, NULL },
602 { "disconnect", do_disconnect, NULL },
603 { "init", do_init, NULL },
604 { "options", do_options, NULL },
609 int wais_obj_init(ClientData clientData, Tcl_Interp *interp,
610 int argc, char **argv, ClientData *subData,
611 ClientData parentData)
613 IrTcl_Methods tab[3];
620 interp->result = "wrong # args";
623 obj = ir_tcl_malloc (sizeof(*obj));
625 obj->interp = interp;
627 logf (LOG_DEBUG, "wais object create %s", argv[1]);
629 r = (*ir_obj_class.ir_init)(clientData, interp, argc, argv, &subP, 0);
632 obj->irtcl_obj = subP;
635 obj->buf_out = ir_tcl_malloc (obj->max_out);
637 free (obj->irtcl_obj->comstackType);
638 ir_tcl_strdup (NULL, &obj->irtcl_obj->comstackType, "wais");
640 tab[0].tab = wais_method_tab;
644 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
646 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
647 /* cleanup missing ... */
656 * wais_obj_delete: Wais Object disposal
658 static void wais_obj_delete (ClientData clientData)
660 WaisTcl_Obj *obj = clientData;
661 IrTcl_Methods tab[3];
664 if (obj->ref_count > 0)
667 logf (LOG_DEBUG, "wais object delete");
669 tab[0].tab = wais_method_tab;
673 ir_tcl_method (NULL, -1, NULL, tab, NULL);
675 (*ir_obj_class.ir_delete)((ClientData) obj->irtcl_obj);
682 * wais_obj_method: Wais Object methods
684 static int wais_obj_method (ClientData clientData, Tcl_Interp *interp,
685 int argc, char **argv)
687 IrTcl_Methods tab[3];
688 WaisTcl_Obj *p = clientData;
694 tab[0].tab = wais_method_tab;
698 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
700 return (*ir_obj_class.ir_method)((ClientData) p->irtcl_obj,
707 * wais_obj_mk: Wais Object creation
709 static int wais_obj_mk (ClientData clientData, Tcl_Interp *interp,
710 int argc, char **argv)
713 int r = wais_obj_init (clientData, interp, argc, argv, &subData, 0);
717 Tcl_CreateCommand (interp, argv[1], wais_obj_method,
718 subData, wais_obj_delete);
722 /* --- S E T S ---------------------------------------------------------- */
724 static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
726 WaisSetTcl_Obj *obj = o;
727 WaisTcl_Obj *p = obj->parent;
728 int i, start, number;
729 static char *element_names[3];
733 SearchAPDU *waisSearch;
740 if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
747 if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
754 interp->result = "present: not connected";
757 element_names[0] = " ";
758 element_names[1] = ES_DocumentText;
759 element_names[2] = NULL;
761 docObjs = ir_tcl_malloc (sizeof(*docObjs) * (number+1));
762 for (i = 0; i<number; i++)
766 rec = wais_lookup_record_pos (obj, i+start);
769 interp->result = "present request out of range";
772 docObjs[i] = makeDocObjUsingLines (rec->documentID, "TEXT", 0,
776 waisQuery = makeWAISTextQuery (docObjs);
778 makeSearchAPDU (30L, /* small */
781 (boolean) obj->irtcl_set_obj->
782 set_inher.replaceIndicator, /* replace indicator */
784 setName, /* result set name */
785 obj->irtcl_set_obj->set_inher.databaseNames,
786 QT_TextRetrievalQuery, /* query type */
787 element_names, /* element name */
788 NULL, /* reference ID */
792 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
793 p->len_out = p->max_out - left;
795 for (i = 0; i<number; i++)
796 CSTFreeDocObj (docObjs[i]);
799 CSTFreeWAISTextQuery (waisQuery);
800 freeSearchAPDU (waisSearch);
803 interp->result = "Couldn't encode Wais text search APDU";
806 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
807 (long) NO_COMPRESSION,
809 (long) HEADER_VERSION);
811 p->len_out += HEADER_LENGTH;
812 return wais_send_apdu (interp, p, "search", argv[0]);
815 static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
817 WaisSetTcl_Obj *obj = o;
818 WaisTcl_Obj *p = obj->parent;
819 WAISSearch *waisQuery;
820 SearchAPDU *waisSearch;
823 DocObj **docObjs = NULL;
827 if (argc < 3 || argc > 4)
829 interp->result = "wrong # args";
834 docObjs = ir_tcl_malloc (2 * sizeof(*docObjs));
836 docObjs[0] = ir_tcl_malloc (sizeof(**docObjs));
837 docObjs[0]->DocumentID = stringToAny (argv[3]);
838 docObjs[0]->Type = NULL;
839 docObjs[0]->ChunkCode = (long) CT_document;
843 if (!obj->irtcl_set_obj->set_inher.num_databaseNames)
845 interp->result = "no databaseNames";
848 logf (LOG_DEBUG, "parent = %p", p);
851 interp->result = "not connected";
854 obj->irtcl_set_obj->resultCount = 0;
855 obj->irtcl_set_obj->searchStatus = 0;
857 makeWAISSearch (argv[2], /* seed words */
858 docObjs, /* doc ptrs */
860 1L, /* date factor */
861 0L, /* begin date range */
862 0L, /* end date range */
863 obj->maxDocs); /* max docs retrieved */
866 makeSearchAPDU (30L, /* small */
869 (boolean) obj->irtcl_set_obj->
870 set_inher.replaceIndicator, /* replace indicator */
872 setName, /* result set name */
873 obj->irtcl_set_obj->set_inher.databaseNames,
874 QT_RelevanceFeedbackQuery,
876 NULL, /* element name */
877 NULL, /* reference ID */
881 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
882 p->len_out = p->max_out - left;
884 CSTFreeWAISSearch (waisQuery);
885 freeSearchAPDU (waisSearch);
888 CSTFreeDocObj (docObjs[0]);
893 interp->result = "Couldn't encode Wais search APDU";
896 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
897 (long) NO_COMPRESSION,
899 (long) HEADER_VERSION);
901 p->len_out += HEADER_LENGTH;
902 return wais_send_apdu (interp, p, "search", argv[0]);
906 * do_responseStatus: Return response status (present or search)
908 static int do_responseStatus (void *o, Tcl_Interp *interp,
909 int argc, char **argv)
911 WaisSetTcl_Obj *obj = o;
926 Tcl_AppendElement (interp, "NSD");
928 Tcl_AppendElement (interp, obj->diag);
929 Tcl_AppendElement (interp, obj->diag);
931 Tcl_AppendElement (interp, obj->addinfo ? obj->addinfo : "");
934 Tcl_AppendElement (interp, "DBOSD");
939 * do_maxDocs: Set number of documents to be retrieved in ranked query
941 static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv)
943 WaisSetTcl_Obj *obj = o;
950 return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv);
955 * do_type: Return type (if any) at position.
957 static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
959 WaisSetTcl_Obj *obj = o;
970 wais_delete_records (obj);
975 sprintf (interp->result, "wrong # args");
978 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
980 rec = wais_lookup_record_pos_bf (obj, offset);
983 logf (LOG_DEBUG, "No record at position %d", offset);
986 interp->result = "DB";
992 * do_recordType: Return record type (if any) at position.
994 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
996 WaisSetTcl_Obj *obj = o;
1006 sprintf (interp->result, "wrong # args");
1009 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1012 rec = wais_lookup_record_pos_bf (obj, offset);
1016 Tcl_AppendElement (interp, "WAIS");
1021 * do_getWAIS: Return WAIS record at position.
1023 static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv)
1025 WaisSetTcl_Obj *obj = o;
1027 WaisTcl_Record *rec;
1036 sprintf (interp->result, "wrong # args: should be"
1037 " \"assoc getWAIS pos field\"\n"
1038 " field is one of:\n"
1039 " score headline documentLength text lines documentID");
1042 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
1044 rec = wais_lookup_record_pos_bf (obj, offset);
1047 if (!strcmp (argv[3], "score"))
1049 sprintf (prbuf, "%ld", (long) rec->score);
1050 Tcl_AppendElement (interp, prbuf);
1052 else if (!strcmp (argv[3], "headline"))
1054 Tcl_AppendElement (interp, rec->headline);
1056 else if (!strcmp (argv[3], "documentLength"))
1058 sprintf (prbuf, "%ld", (long) rec->documentLength);
1059 Tcl_AppendElement (interp, prbuf);
1061 else if (!strcmp (argv[3], "text"))
1063 Tcl_AppendElement (interp, rec->documentText);
1065 else if (!strcmp (argv[3], "lines"))
1067 sprintf (prbuf, "%ld", (long) rec->lines);
1068 Tcl_AppendElement (interp, prbuf);
1070 else if (!strcmp (argv[3], "documentID"))
1072 if (rec->documentID->size >= sizeof(prbuf))
1074 interp->result = "bad documentID";
1077 memcpy (prbuf, rec->documentID->bytes, rec->documentID->size);
1078 prbuf[rec->documentID->size] = '\0';
1079 Tcl_AppendElement (interp, prbuf);
1085 static IrTcl_Method wais_set_method_tab[] = {
1086 { "maxDocs", do_maxDocs, NULL },
1087 { "search", do_search, NULL },
1088 { "present", do_present, NULL },
1089 { "responseStatus", do_responseStatus, NULL },
1090 { "type", do_type, NULL },
1091 { "recordType", do_recordType, NULL },
1092 { "getWAIS", do_getWAIS, NULL },
1097 * wais_obj_method: Wais Set Object methods
1099 static int wais_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1100 int argc, char **argv)
1102 IrTcl_Methods tab[3];
1103 WaisSetTcl_Obj *p = clientData;
1109 tab[0].tab = wais_set_method_tab;
1113 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
1115 return (*ir_set_obj_class.ir_method)((ClientData) p->irtcl_set_obj,
1116 interp, argc, argv);
1121 int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp,
1122 int argc, char **argv, ClientData *subData,
1123 ClientData parentData)
1125 IrTcl_Methods tab[3];
1126 WaisSetTcl_Obj *obj;
1130 assert (parentData);
1133 obj = ir_tcl_malloc (sizeof(*obj));
1134 obj->parent = (WaisTcl_Obj *) parentData;
1135 logf (LOG_DEBUG, "parent = %p", obj->parent);
1136 obj->interp = interp;
1138 obj->addinfo = NULL;
1140 logf (LOG_DEBUG, "wais set object create %s", argv[1]);
1142 r = (*ir_set_obj_class.ir_init)(clientData, interp, argc, argv, &subP,
1143 obj->parent->irtcl_obj);
1146 obj->irtcl_set_obj = subP;
1148 tab[0].tab = wais_set_method_tab;
1152 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
1154 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
1155 /* cleanup missing ... */
1164 * wais_set_obj_delete: Wais Set Object disposal
1166 static void wais_set_obj_delete (ClientData clientData)
1168 WaisSetTcl_Obj *obj = clientData;
1169 IrTcl_Methods tab[3];
1171 logf (LOG_DEBUG, "wais set object delete");
1173 tab[0].tab = wais_set_method_tab;
1177 ir_tcl_method (NULL, -1, NULL, tab, NULL);
1179 (*ir_set_obj_class.ir_delete)((ClientData) obj->irtcl_set_obj);
1185 * wais_set_obj_mk: Wais Set Object creation
1187 static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1188 int argc, char **argv)
1192 Tcl_CmdInfo parent_info;
1196 interp->result = "wrong # args: should be"
1197 " \"wais-set set assoc?\"";
1200 parent_info.clientData = 0;
1201 if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
1203 interp->result = "No parent";
1206 r = wais_set_obj_init (clientData, interp, argc, argv, &subData,
1207 parent_info.clientData);
1210 Tcl_CreateCommand (interp, argv[1], wais_set_obj_method,
1211 subData, wais_set_obj_delete);
1219 int do_htmlToken (ClientData clientData, Tcl_Interp *interp,
1220 int argc, char **argv)
1223 char *tmp_buf = NULL;
1229 interp->result = "wrong # args: should be"
1230 " \"htmlToken var list command\"";
1238 if (*src == ' ' || *src == '\t' || *src == '\n' ||
1239 *src == '\r' || *src == '\f')
1247 while (*src1 != '>' && *src1 != '\n' ** src1)
1254 while (*src1 != '<' && *src1)
1257 if (src1 - src >= tmp_size)
1260 tmp_size = src1 - src + 256;
1261 tmp_buf = ir_tcl_malloc (tmp_size);
1263 memcpy (tmp_buf, src, src1 - src);
1264 tmp_buf[src1-src] = '\0';
1265 Tcl_SetVar (interp, argv[1], tmp_buf, 0);
1266 r = Tcl_Eval (interp, argv[3]);
1267 if (r != TCL_OK && r != TCL_CONTINUE)
1271 if (r == TCL_CONTINUE)
1277 /* --- R E G I S T R A T I O N ---------------------------------------- */
1279 * Waistcl_init: Registration of TCL commands.
1281 int Waistcl_Init (Tcl_Interp *interp)
1283 Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL,
1284 (Tcl_CmdDeleteProc *) NULL);
1285 Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk,
1286 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
1287 Tcl_CreateCommand (interp, "htmlToken", do_htmlToken,
1288 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);