2 * IR toolkit for tcl/tk
3 * (c) Index Data 1995-1996
4 * See the file LICENSE for details.
5 * Sebastian Hammer, Adam Dickmeiss
8 * Revision 1.9 1996-08-16 15:07:44 adam
9 * First work on Explain.
11 * Revision 1.8 1996/07/03 13:31:10 adam
12 * The xmalloc/xfree functions from YAZ are used to manage memory.
14 * Revision 1.7 1996/06/05 09:26:20 adam
15 * Bug fix: the change above introduced an error.
17 * Revision 1.6 1996/06/05 08:59:23 adam
18 * Changed syntax of element specs in GRS-1 retrieval.
20 * Revision 1.5 1996/05/29 20:28:08 adam
21 * Bug fix: Function ir_tcl_grs_del sometimes free'd bad memory.
23 * Revision 1.4 1996/05/29 06:37:42 adam
24 * Function ir_tcl_get_grs_r enhanced so that specific elements can be
27 * Revision 1.3 1996/03/05 09:21:01 adam
28 * Bug fix: memory used by GRS records wasn't freed.
29 * Rewrote some of the error handling code - the connection is always
30 * closed before failback is called.
31 * If failback is defined the send APDU methods (init, search, ...) will
32 * return OK but invoke failback (as is the case if the write operation
34 * Bug fix: ref_count in assoc object could grow if fraction of PDU was
37 * Revision 1.2 1995/09/20 11:37:01 adam
38 * Configure searches for tk4.1 and tk7.5.
41 * Revision 1.1 1995/08/29 15:38:34 adam
42 * Added grs.c. new version.
53 void ir_tcl_grs_del (IrTcl_GRS_Record **grs_record)
55 struct GRS_Record_entry *e;
60 e = (*grs_record)->entries;
61 for (i = 0; i < (*grs_record)->noTags; i++, e++)
65 case Z_StringOrNumeric_numeric:
68 xfree (e->tagVal.str);
72 case Z_ElementData_octets:
73 xfree (e->tagData.octets.buf);
75 case Z_ElementData_numeric:
77 case Z_ElementData_date:
78 xfree (e->tagData.str);
80 case Z_ElementData_ext:
82 case Z_ElementData_string:
83 xfree (e->tagData.str);
85 case Z_ElementData_trueOrFalse:
86 case Z_ElementData_oid:
87 case Z_ElementData_intUnit:
88 case Z_ElementData_elementNotThere:
89 case Z_ElementData_elementEmpty:
90 case Z_ElementData_noDataRequested:
91 case Z_ElementData_diagnostic:
93 case Z_ElementData_subtree:
94 ir_tcl_grs_del (&e->tagData.sub);
98 xfree ((*grs_record)->entries);
103 void ir_tcl_grs_mk (Z_GenericRecord *r, IrTcl_GRS_Record **grs_record)
106 struct GRS_Record_entry *e;
111 *grs_record = ir_tcl_malloc (sizeof(**grs_record));
112 if (!((*grs_record)->noTags = r->num_elements))
114 (*grs_record)->entries = NULL;
117 e = (*grs_record)->entries = ir_tcl_malloc (r->num_elements *
119 for (i = 0; i < r->num_elements; i++, e++)
125 e->tagType = *t->tagType;
128 e->tagWhich = t->tagValue->which;
129 if (t->tagValue->which == Z_StringOrNumeric_numeric)
130 e->tagVal.num = *t->tagValue->u.numeric;
132 ir_tcl_strdup (NULL, &e->tagVal.str, t->tagValue->u.string);
133 e->dataWhich = t->content->which;
135 switch (t->content->which)
137 case Z_ElementData_octets:
138 e->tagData.octets.len = t->content->u.octets->len;
139 e->tagData.octets.buf = ir_tcl_malloc (t->content->u.octets->len);
140 memcpy (e->tagData.octets.buf, t->content->u.octets->buf,
141 t->content->u.octets->len);
143 case Z_ElementData_numeric:
144 e->tagData.num = *t->content->u.numeric;
146 case Z_ElementData_date:
147 ir_tcl_strdup (NULL, &e->tagData.str, t->content->u.string);
149 case Z_ElementData_ext:
151 case Z_ElementData_string:
152 ir_tcl_strdup (NULL, &e->tagData.str, t->content->u.string);
154 case Z_ElementData_trueOrFalse:
155 e->tagData.bool = *t->content->u.trueOrFalse;
157 case Z_ElementData_oid:
159 case Z_ElementData_intUnit:
161 case Z_ElementData_elementNotThere:
162 case Z_ElementData_elementEmpty:
163 case Z_ElementData_noDataRequested:
165 case Z_ElementData_diagnostic:
167 case Z_ElementData_subtree:
168 ir_tcl_grs_mk (t->content->u.subtree, &e->tagData.sub);
174 static int ir_tcl_get_grs_r (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
175 int argc, char **argv, int argno)
177 static char tmpbuf[32];
179 struct GRS_Record_entry *e = grs_record->entries;
181 for (i = 0; i<grs_record->noTags; i++, e++)
188 const char *cp0 = argv[argno];
189 const char *cp1 = strchr (cp0, ',');
191 if (!cp1 || cp1-cp0 < 1)
197 if (atoi(cp0) == e->tagType)
199 if (e->tagWhich == Z_StringOrNumeric_numeric)
201 if (atoi (cp1+1) == e->tagVal.num)
206 int len = strlen(cp1+1);
209 if (len && strlen(e->tagVal.str) == len &&
210 !memcmp (cp1+1, e->tagVal.str, len))
218 Tcl_AppendResult (interp, "{ ", NULL);
219 sprintf (tmpbuf, "%d", e->tagType);
220 Tcl_AppendElement (interp, tmpbuf);
222 if (e->tagWhich == Z_StringOrNumeric_numeric)
224 Tcl_AppendResult (interp, " numeric ", NULL);
225 sprintf (tmpbuf, "%d", e->tagVal.num);
226 Tcl_AppendElement (interp, tmpbuf);
230 Tcl_AppendResult (interp, " string ", NULL);
231 Tcl_AppendElement (interp, e->tagVal.str);
233 switch (e->dataWhich)
235 case Z_ElementData_octets:
236 Tcl_AppendResult (interp, " octets {} ", NULL);
238 case Z_ElementData_numeric:
239 Tcl_AppendResult (interp, " numeric ", NULL);
240 sprintf (tmpbuf, "%d", e->tagData.num);
241 Tcl_AppendElement (interp, tmpbuf);
243 case Z_ElementData_date:
244 Tcl_AppendResult (interp, " date {} ", NULL);
246 case Z_ElementData_ext:
247 Tcl_AppendResult (interp, " ext {} ", NULL);
249 case Z_ElementData_string:
250 Tcl_AppendResult (interp, " string ", NULL);
251 Tcl_AppendElement (interp, e->tagData.str);
253 case Z_ElementData_trueOrFalse:
254 Tcl_AppendResult (interp, " bool ",
255 e->tagData.bool ? "1" : "0", " ", NULL);
257 case Z_ElementData_oid:
258 Tcl_AppendResult (interp, " oid {} ", NULL);
260 case Z_ElementData_intUnit:
261 Tcl_AppendResult (interp, " intUnit {} ", NULL);
263 case Z_ElementData_elementNotThere:
264 Tcl_AppendResult (interp, " notThere {} ", NULL);
266 case Z_ElementData_elementEmpty:
267 Tcl_AppendResult (interp, " empty {} ", NULL);
269 case Z_ElementData_noDataRequested:
270 Tcl_AppendResult (interp, " notRequested {} ", NULL);
272 case Z_ElementData_diagnostic:
273 Tcl_AppendResult (interp, " diagnostic {} ", NULL);
275 case Z_ElementData_subtree:
276 Tcl_AppendResult (interp, " subtree { ", NULL);
277 ir_tcl_get_grs_r (interp, e->tagData.sub, argc, argv, argno+1);
278 Tcl_AppendResult (interp, " } ", NULL);
281 Tcl_AppendResult (interp, " } ", NULL);
286 int ir_tcl_get_grs (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
287 int argc, char **argv)
289 return ir_tcl_get_grs_r (interp, grs_record, argc, argv, 3);