2 * IR toolkit for tcl/tk
4 * See the file LICENSE for details.
5 * Sebastian Hammer, Adam Dickmeiss
8 * Revision 1.7 1995-11-09 15:24:02 adam
9 * Allow charsets [..] in record match.
11 * Revision 1.6 1995/08/28 12:21:22 adam
12 * Removed lines and list as synonyms of list in MARC extractron.
13 * Configure searches also for tk4.0 / tcl7.4.
15 * Revision 1.5 1995/06/30 12:39:26 adam
16 * Bug fix: loadFile didn't set record type.
17 * The MARC routines are a little less strict in the interpretation.
18 * Script display.tcl replaces the old marc.tcl.
19 * New interactive script: shell.tcl.
21 * Revision 1.4 1995/06/22 13:15:09 adam
22 * Feature: SUTRS. Setting getSutrs implemented.
23 * Work on display formats.
24 * Preferred record syntax can be set by the user.
26 * Revision 1.3 1995/05/29 08:44:26 adam
27 * Work on delete of objects.
29 * Revision 1.2 1995/05/26 11:44:11 adam
30 * Bugs fixed. More work on MARC utilities and queries. Test
31 * client is up-to-date again.
33 * Revision 1.1 1995/05/26 08:54:19 adam
34 * New MARC utilities. Uses prefix query.
45 #define ISO2709_RS 035
46 #define ISO2709_FS 036
47 #define ISO2709_IDFS 037
49 static int atoi_n (const char *buf, int len)
53 if (!isdigit (buf[len-1]))
58 val = val*10 + (*buf - '0');
64 static int marc_compare (const char *f, const char *p)
72 for (; (ch = *p) && *f; f++, p++)
101 char *ir_tcl_fread_marc (FILE *inf, size_t *size)
106 if (fread (length, 1, 5, inf) != 5)
108 *size = atoi_n (length, 5);
111 if (!(buf = malloc (*size+1)))
113 if (fread (buf+5, 1, *size-5, inf) != (*size-5))
118 memcpy (buf, length, 5);
123 int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
124 int argc, char **argv)
128 int indicator_length;
129 int identifier_length;
131 int length_data_entry;
133 int length_implementation;
138 if (!strcmp (argv[3], "field"))
140 else if (!strcmp (argv[3], "line"))
144 Tcl_AppendResult (interp, "Unknown MARC extract mode", NULL);
149 Tcl_AppendResult (interp, "Not a MARC record", NULL);
152 record_length = atoi_n (buf, 5);
153 if (record_length < 25)
155 Tcl_AppendResult (interp, "Not a MARC record", NULL);
158 indicator_length = atoi_n (buf+10, 1);
159 identifier_length = atoi_n (buf+11, 1);
160 base_address = atoi_n (buf+12, 4);
162 length_data_entry = atoi_n (buf+20, 1);
163 length_starting = atoi_n (buf+21, 1);
164 length_implementation = atoi_n (buf+22, 1);
166 for (entry_p = 24; buf[entry_p] != ISO2709_FS; )
167 entry_p += 3+length_data_entry+length_starting;
168 base_address = entry_p+1;
169 for (entry_p = 24; buf[entry_p] != ISO2709_FS; )
177 char identifier[128];
179 memcpy (tag, buf+entry_p, 3);
182 data_length = atoi_n (buf+entry_p, length_data_entry);
183 entry_p += length_data_entry;
184 data_offset = atoi_n (buf+entry_p, length_starting);
185 entry_p += length_starting;
186 i = data_offset + base_address;
187 end_offset = i+data_length-1;
189 if (memcmp (tag, "00", 2) && indicator_length)
191 for (j = 0; j<indicator_length; j++)
192 indicator[j] = buf[i++];
195 if (marc_compare (tag, argv[4]) || marc_compare (indicator, argv[5]))
197 while (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS && i < end_offset)
201 if (memcmp (tag, "00", 2) && identifier_length)
204 for (j = 1; j<identifier_length; j++)
205 identifier[j-1] = buf[i++];
206 identifier[j-1] = '\0';
207 for (i0 = i; buf[i] != ISO2709_RS &&
208 buf[i] != ISO2709_IDFS &&
209 buf[i] != ISO2709_FS && i < end_offset;
215 for (i0 = i; buf[i] != ISO2709_RS &&
216 buf[i] != ISO2709_FS && i < end_offset;
221 if (marc_compare (identifier, argv[6])==0)
223 char *data = malloc (i-i0+1);
225 memcpy (data, buf+i0, i-i0);
229 if (strcmp (tag, ptag))
232 Tcl_AppendResult (interp, "}} ", NULL);
234 Tcl_AppendResult (interp, "{", tag, " {} {", NULL);
236 Tcl_AppendResult (interp, "{", tag, " {",
237 indicator, "} {", NULL);
241 Tcl_AppendResult (interp, "{{}", NULL);
243 Tcl_AppendResult (interp, "{", identifier, NULL);
244 Tcl_AppendElement (interp, data);
245 Tcl_AppendResult (interp, "} ", NULL);
248 Tcl_AppendElement (interp, data);
253 logf (LOG_WARN, "MARC: separator but not at end of field");
254 if (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS)
255 logf (LOG_WARN, "MARC: no separator at end of field");
257 if (mode == 'l' && *ptag)
258 Tcl_AppendResult (interp, "}} ", NULL);