2 * IR toolkit for tcl/tk
4 * See the file LICENSE for details.
5 * Sebastian Hammer, Adam Dickmeiss
8 * Revision 1.11 2005-03-10 13:54:38 adam
9 * Define irtcl_atoi_n rather than the YAZ function atoi_n
11 * Revision 1.10 1999/02/08 09:22:31 franck
12 * Added a grs mode for ir_tcl_get_marc which returns MARC records in a TCL
13 * structure similar to that of ir_tcl_get_grs.
15 * Revision 1.9 1996/07/03 13:31:13 adam
16 * The xmalloc/xfree functions from YAZ are used to manage memory.
18 * Revision 1.8 1995/11/14 16:48:00 adam
19 * Bug fix: record extraction in line mode merged lines with same tag.
21 * Revision 1.7 1995/11/09 15:24:02 adam
22 * Allow charsets [..] in record match.
24 * Revision 1.6 1995/08/28 12:21:22 adam
25 * Removed lines and list as synonyms of list in MARC extractron.
26 * Configure searches also for tk4.0 / tcl7.4.
28 * Revision 1.5 1995/06/30 12:39:26 adam
29 * Bug fix: loadFile didn't set record type.
30 * The MARC routines are a little less strict in the interpretation.
31 * Script display.tcl replaces the old marc.tcl.
32 * New interactive script: shell.tcl.
34 * Revision 1.4 1995/06/22 13:15:09 adam
35 * Feature: SUTRS. Setting getSutrs implemented.
36 * Work on display formats.
37 * Preferred record syntax can be set by the user.
39 * Revision 1.3 1995/05/29 08:44:26 adam
40 * Work on delete of objects.
42 * Revision 1.2 1995/05/26 11:44:11 adam
43 * Bugs fixed. More work on MARC utilities and queries. Test
44 * client is up-to-date again.
46 * Revision 1.1 1995/05/26 08:54:19 adam
47 * New MARC utilities. Uses prefix query.
58 #define ISO2709_RS 035
59 #define ISO2709_FS 036
60 #define ISO2709_IDFS 037
62 static int irtcl_atoi_n (const char *buf, int len)
66 if (!isdigit (buf[len-1]))
71 val = val*10 + (*buf - '0');
77 static int marc_compare (const char *f, const char *p)
85 for (; (ch = *p) && *f; f++, p++)
114 char *ir_tcl_fread_marc (FILE *inf, size_t *size)
119 if (fread (length, 1, 5, inf) != 5)
121 *size = irtcl_atoi_n (length, 5);
124 if (!(buf = xmalloc (*size+1)))
126 if (fread (buf+5, 1, *size-5, inf) != (*size-5))
131 memcpy (buf, length, 5);
136 int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
137 int argc, char **argv)
141 int indicator_length;
142 int identifier_length;
144 int length_data_entry;
146 int length_implementation;
150 if (!strcmp (argv[3], "field"))
152 else if (!strcmp (argv[3], "line"))
154 else if (!strcmp (argv[3], "grs"))
158 Tcl_AppendResult (interp, "Unknown MARC extract mode", NULL);
163 Tcl_AppendResult (interp, "Not a MARC record", NULL);
166 record_length = irtcl_atoi_n (buf, 5);
167 if (record_length < 25)
169 Tcl_AppendResult (interp, "Not a MARC record", NULL);
172 indicator_length = irtcl_atoi_n (buf+10, 1);
173 identifier_length = irtcl_atoi_n (buf+11, 1);
174 base_address = irtcl_atoi_n (buf+12, 4);
176 length_data_entry = irtcl_atoi_n (buf+20, 1);
177 length_starting = irtcl_atoi_n (buf+21, 1);
178 length_implementation = irtcl_atoi_n (buf+22, 1);
180 for (entry_p = 24; buf[entry_p] != ISO2709_FS; )
181 entry_p += 3+length_data_entry+length_starting;
182 base_address = entry_p+1;
183 for (entry_p = 24; buf[entry_p] != ISO2709_FS; )
191 char identifier[128];
194 memcpy (tag, buf+entry_p, 3);
197 data_length = irtcl_atoi_n (buf+entry_p, length_data_entry);
198 entry_p += length_data_entry;
199 data_offset = irtcl_atoi_n (buf+entry_p, length_starting);
200 entry_p += length_starting;
201 i = data_offset + base_address;
202 end_offset = i+data_length-1;
204 if (memcmp (tag, "00", 2) && indicator_length)
206 for (j = 0; j<indicator_length; j++)
207 indicator[j] = buf[i++];
210 if (marc_compare (tag, argv[4]) || marc_compare (indicator, argv[5]))
212 while (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS && i < end_offset)
216 if (memcmp (tag, "00", 2) && identifier_length)
219 for (j = 1; j<identifier_length; j++)
220 identifier[j-1] = buf[i++];
221 identifier[j-1] = '\0';
222 for (i0 = i; buf[i] != ISO2709_RS &&
223 buf[i] != ISO2709_IDFS &&
224 buf[i] != ISO2709_FS && i < end_offset;
230 for (i0 = i; buf[i] != ISO2709_RS &&
231 buf[i] != ISO2709_FS && i < end_offset;
236 if (marc_compare (identifier, argv[6])==0)
238 char *data = xmalloc (i-i0+1);
240 memcpy (data, buf+i0, i-i0);
244 if (strcmp (tag, ptag))
247 Tcl_AppendResult (interp, "}} ", NULL);
249 Tcl_AppendResult (interp, "{", tag, " {} {", NULL);
251 Tcl_AppendResult (interp, "{", tag, " {",
252 indicator, "} {", NULL);
256 Tcl_AppendResult (interp, "{{}", NULL);
258 Tcl_AppendResult (interp, "{", identifier, NULL);
259 Tcl_AppendElement (interp, data);
260 Tcl_AppendResult (interp, "} ", NULL);
262 else if (mode == 'g')
264 if (strcmp (tag, ptag))
267 Tcl_AppendResult (interp, "}} ", NULL);
269 Tcl_AppendResult (interp, "{ 0 numeric {", tag,
270 indicator, "} subtree {", NULL);
272 Tcl_AppendResult (interp, "{ 0 numeric ", tag,
277 Tcl_AppendResult (interp, "{3 string ", identifier,
280 Tcl_AppendResult (interp, "{1 numeric 19 string ",
282 Tcl_AppendElement (interp, data);
283 Tcl_AppendResult (interp, "} ", NULL);
286 Tcl_AppendElement (interp, data);
290 if (((mode == 'l') || (mode == 'g')) && *ptag)
291 Tcl_AppendResult (interp, "}} ", NULL);
293 logf (LOG_WARN, "MARC: separator but not at end of field");
294 if (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS)
295 logf (LOG_WARN, "MARC: no separator at end of field");