2 * IR toolkit for tcl/tk
3 * (c) Index Data 1995-1997
4 * See the file LICENSE for details.
5 * Sebastian Hammer, Adam Dickmeiss
8 * Revision 1.11 1997-11-19 11:22:09 adam
9 * Object identifiers can be accessed in GRS-1 records.
11 * Revision 1.10 1997/09/09 10:19:52 adam
12 * New MSV5.0 port with fewer warnings.
14 * Revision 1.9 1996/08/16 15:07:44 adam
15 * First work on Explain.
17 * Revision 1.8 1996/07/03 13:31:10 adam
18 * The xmalloc/xfree functions from YAZ are used to manage memory.
20 * Revision 1.7 1996/06/05 09:26:20 adam
21 * Bug fix: the change above introduced an error.
23 * Revision 1.6 1996/06/05 08:59:23 adam
24 * Changed syntax of element specs in GRS-1 retrieval.
26 * Revision 1.5 1996/05/29 20:28:08 adam
27 * Bug fix: Function ir_tcl_grs_del sometimes free'd bad memory.
29 * Revision 1.4 1996/05/29 06:37:42 adam
30 * Function ir_tcl_get_grs_r enhanced so that specific elements can be
33 * Revision 1.3 1996/03/05 09:21:01 adam
34 * Bug fix: memory used by GRS records wasn't freed.
35 * Rewrote some of the error handling code - the connection is always
36 * closed before failback is called.
37 * If failback is defined the send APDU methods (init, search, ...) will
38 * return OK but invoke failback (as is the case if the write operation
40 * Bug fix: ref_count in assoc object could grow if fraction of PDU was
43 * Revision 1.2 1995/09/20 11:37:01 adam
44 * Configure searches for tk4.1 and tk7.5.
47 * Revision 1.1 1995/08/29 15:38:34 adam
48 * Added grs.c. new version.
59 void ir_tcl_grs_del (IrTcl_GRS_Record **grs_record)
61 struct GRS_Record_entry *e;
66 e = (*grs_record)->entries;
67 for (i = 0; i < (*grs_record)->noTags; i++, e++)
71 case Z_StringOrNumeric_numeric:
74 xfree (e->tagVal.str);
78 case Z_ElementData_octets:
79 xfree (e->tagData.octets.buf);
81 case Z_ElementData_numeric:
83 case Z_ElementData_date:
84 xfree (e->tagData.str);
86 case Z_ElementData_ext:
88 case Z_ElementData_string:
89 xfree (e->tagData.str);
91 case Z_ElementData_trueOrFalse:
92 case Z_ElementData_oid:
93 xfree (e->tagData.oid);
95 case Z_ElementData_intUnit:
96 case Z_ElementData_elementNotThere:
97 case Z_ElementData_elementEmpty:
98 case Z_ElementData_noDataRequested:
99 case Z_ElementData_diagnostic:
101 case Z_ElementData_subtree:
102 ir_tcl_grs_del (&e->tagData.sub);
106 xfree ((*grs_record)->entries);
111 void ir_tcl_grs_mk (Z_GenericRecord *r, IrTcl_GRS_Record **grs_record)
114 struct GRS_Record_entry *e;
119 *grs_record = ir_tcl_malloc (sizeof(**grs_record));
120 if (!((*grs_record)->noTags = r->num_elements))
122 (*grs_record)->entries = NULL;
125 e = (*grs_record)->entries = ir_tcl_malloc (r->num_elements *
127 for (i = 0; i < r->num_elements; i++, e++)
134 e->tagType = *t->tagType;
137 e->tagWhich = t->tagValue->which;
138 if (t->tagValue->which == Z_StringOrNumeric_numeric)
139 e->tagVal.num = *t->tagValue->u.numeric;
141 ir_tcl_strdup (NULL, &e->tagVal.str, t->tagValue->u.string);
142 e->dataWhich = t->content->which;
144 switch (t->content->which)
146 case Z_ElementData_octets:
147 e->tagData.octets.len = t->content->u.octets->len;
148 e->tagData.octets.buf = ir_tcl_malloc (t->content->u.octets->len);
149 memcpy (e->tagData.octets.buf, t->content->u.octets->buf,
150 t->content->u.octets->len);
152 case Z_ElementData_numeric:
153 e->tagData.num = *t->content->u.numeric;
155 case Z_ElementData_date:
156 ir_tcl_strdup (NULL, &e->tagData.str, t->content->u.string);
158 case Z_ElementData_ext:
160 case Z_ElementData_string:
161 ir_tcl_strdup (NULL, &e->tagData.str, t->content->u.string);
163 case Z_ElementData_trueOrFalse:
164 e->tagData.bool = *t->content->u.trueOrFalse;
166 case Z_ElementData_oid:
167 len = 1+oid_oidlen (t->content->u.oid);
168 e->tagData.oid = ir_tcl_malloc (len * sizeof(*e->tagData.oid));
169 memcpy (e->tagData.oid, t->content->u.oid,
170 len * sizeof(*e->tagData.oid));
172 case Z_ElementData_intUnit:
174 case Z_ElementData_elementNotThere:
175 case Z_ElementData_elementEmpty:
176 case Z_ElementData_noDataRequested:
178 case Z_ElementData_diagnostic:
180 case Z_ElementData_subtree:
181 ir_tcl_grs_mk (t->content->u.subtree, &e->tagData.sub);
187 static int ir_tcl_get_grs_r (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
188 int argc, char **argv, int argno)
190 static char tmpbuf[32];
192 struct GRS_Record_entry *e = grs_record->entries;
194 for (i = 0; i<grs_record->noTags; i++, e++)
201 const char *cp0 = argv[argno];
202 const char *cp1 = strchr (cp0, ',');
204 if (!cp1 || cp1-cp0 < 1)
210 if (atoi(cp0) == e->tagType)
212 if (e->tagWhich == Z_StringOrNumeric_numeric)
214 if (atoi (cp1+1) == e->tagVal.num)
219 size_t len = strlen(cp1+1);
222 if (len && strlen(e->tagVal.str) == len &&
223 !memcmp (cp1+1, e->tagVal.str, len))
231 Tcl_AppendResult (interp, "{ ", NULL);
232 sprintf (tmpbuf, "%d", e->tagType);
233 Tcl_AppendElement (interp, tmpbuf);
235 if (e->tagWhich == Z_StringOrNumeric_numeric)
237 Tcl_AppendResult (interp, " numeric ", NULL);
238 sprintf (tmpbuf, "%d", e->tagVal.num);
239 Tcl_AppendElement (interp, tmpbuf);
243 Tcl_AppendResult (interp, " string ", NULL);
244 Tcl_AppendElement (interp, e->tagVal.str);
246 switch (e->dataWhich)
248 case Z_ElementData_octets:
249 Tcl_AppendResult (interp, " octets {} ", NULL);
251 case Z_ElementData_numeric:
252 Tcl_AppendResult (interp, " numeric ", NULL);
253 sprintf (tmpbuf, "%d", e->tagData.num);
254 Tcl_AppendElement (interp, tmpbuf);
256 case Z_ElementData_date:
257 Tcl_AppendResult (interp, " date {} ", NULL);
259 case Z_ElementData_ext:
260 Tcl_AppendResult (interp, " ext {} ", NULL);
262 case Z_ElementData_string:
263 Tcl_AppendResult (interp, " string ", NULL);
264 Tcl_AppendElement (interp, e->tagData.str);
266 case Z_ElementData_trueOrFalse:
267 Tcl_AppendResult (interp, " bool ",
268 e->tagData.bool ? "1" : "0", " ", NULL);
270 case Z_ElementData_oid:
271 Tcl_AppendResult (interp, " oid", NULL);
273 Tcl_AppendResult (interp, "{}", NULL);
278 for (i = 0; e->tagData.oid[i] >= 0; i++)
280 sprintf (tmpbuf, "%c%d", sep, e->tagData.oid[i]);
281 Tcl_AppendResult (interp, tmpbuf, NULL);
286 case Z_ElementData_intUnit:
287 Tcl_AppendResult (interp, " intUnit {} ", NULL);
289 case Z_ElementData_elementNotThere:
290 Tcl_AppendResult (interp, " notThere {} ", NULL);
292 case Z_ElementData_elementEmpty:
293 Tcl_AppendResult (interp, " empty {} ", NULL);
295 case Z_ElementData_noDataRequested:
296 Tcl_AppendResult (interp, " notRequested {} ", NULL);
298 case Z_ElementData_diagnostic:
299 Tcl_AppendResult (interp, " diagnostic {} ", NULL);
301 case Z_ElementData_subtree:
302 Tcl_AppendResult (interp, " subtree { ", NULL);
303 ir_tcl_get_grs_r (interp, e->tagData.sub, argc, argv, argno+1);
304 Tcl_AppendResult (interp, " } ", NULL);
307 Tcl_AppendResult (interp, " } ", NULL);
312 int ir_tcl_get_grs (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
313 int argc, char **argv)
315 return ir_tcl_get_grs_r (interp, grs_record, argc, argv, 3);