2 * IR toolkit for tcl/tk
4 * See the file LICENSE for details.
5 * Sebastian Hammer, Adam Dickmeiss
8 * Revision 1.3 1996-03-05 09:21:01 adam
9 * Bug fix: memory used by GRS records wasn't freed.
10 * Rewrote some of the error handling code - the connection is always
11 * closed before failback is called.
12 * If failback is defined the send APDU methods (init, search, ...) will
13 * return OK but invoke failback (as is the case if the write operation
15 * Bug fix: ref_count in assoc object could grow if fraction of PDU was
18 * Revision 1.2 1995/09/20 11:37:01 adam
19 * Configure searches for tk4.1 and tk7.5.
22 * Revision 1.1 1995/08/29 15:38:34 adam
23 * Added grs.c. new version.
34 void ir_tcl_grs_del (IrTcl_GRS_Record **grs_record)
36 struct GRS_Record_entry *e;
41 e = (*grs_record)->entries;
42 for (i = 0; i < (*grs_record)->noTags; i++, e++)
46 case Z_StringOrNumeric_numeric:
53 case Z_ElementData_octets:
54 free (e->tagData.octets.buf);
56 case Z_ElementData_numeric:
58 case Z_ElementData_date:
59 free (e->tagData.str);
61 case Z_ElementData_ext:
63 case Z_ElementData_string:
64 free (e->tagData.str);
66 case Z_ElementData_trueOrFalse:
67 case Z_ElementData_oid:
68 case Z_ElementData_intUnit:
69 case Z_ElementData_elementNotThere:
70 case Z_ElementData_elementEmpty:
71 case Z_ElementData_noDataRequested:
72 case Z_ElementData_diagnostic:
74 case Z_ElementData_subtree:
75 ir_tcl_grs_del (&e->tagData.sub);
79 free ((*grs_record)->entries);
84 void ir_tcl_grs_mk (Z_GenericRecord *r, IrTcl_GRS_Record **grs_record)
87 struct GRS_Record_entry *e;
92 *grs_record = ir_tcl_malloc (sizeof(**grs_record));
93 if (!((*grs_record)->noTags = r->num_elements))
95 (*grs_record)->entries = NULL;
98 e = (*grs_record)->entries = ir_tcl_malloc (r->num_elements *
100 for (i = 0; i < r->num_elements; i++, e++)
106 e->tagType = *t->tagType;
109 e->tagWhich = t->tagValue->which;
110 if (t->tagValue->which == Z_StringOrNumeric_numeric)
111 e->tagVal.num = *t->tagValue->u.numeric;
113 ir_tcl_strdup (NULL, &e->tagVal.str, t->tagValue->u.string);
114 e->dataWhich = t->content->which;
116 switch (t->content->which)
118 case Z_ElementData_octets:
119 e->tagData.octets.len = t->content->u.octets->len;
120 e->tagData.octets.buf = ir_tcl_malloc (t->content->u.octets->len);
121 memcpy (e->tagData.octets.buf, t->content->u.octets->buf,
122 t->content->u.octets->len);
124 case Z_ElementData_numeric:
125 e->tagData.num = *t->content->u.numeric;
127 case Z_ElementData_date:
128 ir_tcl_strdup (NULL, &e->tagData.str, t->content->u.string);
130 case Z_ElementData_ext:
132 case Z_ElementData_string:
133 ir_tcl_strdup (NULL, &e->tagData.str, t->content->u.string);
135 case Z_ElementData_trueOrFalse:
136 e->tagData.bool = *t->content->u.trueOrFalse;
138 case Z_ElementData_oid:
140 case Z_ElementData_intUnit:
142 case Z_ElementData_elementNotThere:
143 case Z_ElementData_elementEmpty:
144 case Z_ElementData_noDataRequested:
146 case Z_ElementData_diagnostic:
148 case Z_ElementData_subtree:
149 ir_tcl_grs_mk (t->content->u.subtree, &e->tagData.sub);
155 static int ir_tcl_get_grs_r (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
156 int argc, char **argv, int argno)
158 static char tmpbuf[32];
160 struct GRS_Record_entry *e = grs_record->entries;
164 for (i = 0; i<grs_record->noTags; i++, e++)
167 Tcl_AppendResult (interp, "{ ", NULL);
168 sprintf (tmpbuf, "%d", e->tagType);
169 Tcl_AppendElement (interp, tmpbuf);
171 if (e->tagWhich == Z_StringOrNumeric_numeric)
173 Tcl_AppendResult (interp, " numeric ", NULL);
174 sprintf (tmpbuf, "%d", e->tagVal.num);
175 Tcl_AppendElement (interp, tmpbuf);
179 Tcl_AppendResult (interp, " string ", NULL);
180 Tcl_AppendElement (interp, e->tagVal.str);
182 switch (e->dataWhich)
184 case Z_ElementData_octets:
185 Tcl_AppendResult (interp, " octets {} ", NULL);
187 case Z_ElementData_numeric:
188 Tcl_AppendResult (interp, " numeric {} ", NULL);
190 case Z_ElementData_date:
191 Tcl_AppendResult (interp, " date {} ", NULL);
193 case Z_ElementData_ext:
194 Tcl_AppendResult (interp, " ext {} ", NULL);
196 case Z_ElementData_string:
197 Tcl_AppendResult (interp, " string ", NULL);
198 Tcl_AppendElement (interp, e->tagData.str );
200 case Z_ElementData_trueOrFalse:
201 Tcl_AppendResult (interp, " bool ",
202 e->tagData.bool ? "1" : "0", " ", NULL);
204 case Z_ElementData_oid:
205 Tcl_AppendResult (interp, " oid {} ", NULL);
207 case Z_ElementData_intUnit:
208 Tcl_AppendResult (interp, " intUnit {} ", NULL);
210 case Z_ElementData_elementNotThere:
211 Tcl_AppendResult (interp, " notThere {} ", NULL);
213 case Z_ElementData_elementEmpty:
214 Tcl_AppendResult (interp, " empty {} ", NULL);
216 case Z_ElementData_noDataRequested:
217 Tcl_AppendResult (interp, " notRequested {} ", NULL);
219 case Z_ElementData_diagnostic:
220 Tcl_AppendResult (interp, " diagnostic {} ", NULL);
222 case Z_ElementData_subtree:
223 Tcl_AppendResult (interp, " subtree { ", NULL);
224 ir_tcl_get_grs_r (interp, e->tagData.sub, argc, argv, argno+1);
225 Tcl_AppendResult (interp, " } ", NULL);
228 Tcl_AppendResult (interp, " } ", NULL);
234 int ir_tcl_get_grs (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
235 int argc, char **argv)
237 return ir_tcl_get_grs_r (interp, grs_record, argc, argv, 4);