From: Adam Dickmeiss <adam@indexdata.dk>
Date: Fri, 26 May 1995 08:54:11 +0000 (+0000)
Subject: New MARC utilities. Uses prefix query.
X-Git-Tag: IRTCL.1.4~309
X-Git-Url: http://sru.miketaylor.org.uk/cgi-bin?a=commitdiff_plain;h=06c9c5c547ac216c72d12b0d9b3539b9038d8a05;p=ir-tcl-moved-to-github.git

New MARC utilities. Uses prefix query.
---

diff --git a/ir-tcl.c b/ir-tcl.c
index a9663ff..b84806d 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -4,7 +4,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.29  1995-05-24 14:10:22  adam
+ * Revision 1.30  1995-05-26 08:54:11  adam
+ * New MARC utilities. Uses prefix query.
+ *
+ * Revision 1.29  1995/05/24  14:10:22  adam
  * Work on idAuthentication, protocolVersion and options.
  *
  * Revision 1.28  1995/05/23  15:34:48  adam
@@ -123,7 +126,8 @@ static IRRecordList *new_IR_record (IRSetObj *setobj, int no, int which)
             switch (rl->which)
             {
             case Z_NamePlusRecord_databaseRecord:
-                iso2709_rm (rl->u.marc.rec);
+	        free (rl->u.dbrec.buf);
+		rl->u.dbrec.buf = NULL;
                 break;
             case Z_NamePlusRecord_surrogateDiagnostic:
                 free (rl->u.diag.addinfo);
@@ -1025,7 +1029,9 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
               int argc, char **argv)
 {
     IRObj *obj;
+#if CCL2RPN
     FILE *inf;
+#endif
 
     if (argc != 2)
     {
@@ -1067,12 +1073,14 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp,
     
     obj->hostname = NULL;
 
+#if CCL2RPN
     obj->bibset = ccl_qual_mk (); 
     if ((inf = fopen ("default.bib", "r")))
     {
     	ccl_qual_file (obj->bibset, inf);
     	fclose (inf);
     }
+#endif
     ODR_MASK_ZERO (&obj->protocolVersion);
     ODR_MASK_SET (&obj->protocolVersion, 0);
     ODR_MASK_SET (&obj->protocolVersion, 1);
@@ -1149,9 +1157,7 @@ static int do_search (void *o, Tcl_Interp *interp,
     req.databaseNames = p->set_inher.databaseNames;
     printf ("Search:");
     for (r=0; r < p->set_inher.num_databaseNames; r++)
-    {
         printf (" %s", p->set_inher.databaseNames[r]);
-    }
     req.smallSetElementSetNames = 0;
     req.mediumSetElementSetNames = 0;
     req.preferredRecordSyntax = 0;
@@ -1159,6 +1165,22 @@ static int do_search (void *o, Tcl_Interp *interp,
 
     if (!strcmp (p->set_inher.queryType, "rpn"))
     {
+        Z_RPNQuery *RPNquery;
+
+        RPNquery = p_query_rpn (p->odr_out, argv[2]);
+	if (!RPNquery)
+	{
+            Tcl_AppendResult (interp, "Syntax error in query", NULL);
+            return TCL_ERROR;
+        }
+        RPNquery->attributeSetId = oid_getoidbyent (&p->bib1);
+        query.which = Z_Query_type_1;
+        query.u.type_1 = RPNquery;
+        printf ("- RPN\n");
+    }
+#if CCL2RPN
+    else if (!strcmp (p->set_inher.queryType, "cclrpn"))
+    {
         int error;
         int pos;
         struct ccl_rpn_node *rpn;
@@ -1172,12 +1194,13 @@ static int do_search (void *o, Tcl_Interp *interp,
         }
         ccl_pr_tree (rpn, stderr);
         fprintf (stderr, "\n");
-        query.which = Z_Query_type_1;
         assert((RPNquery = ccl_rpn_query(rpn)));
         RPNquery->attributeSetId = oid_getoidbyent (&p->bib1);
+        query.which = Z_Query_type_1;
         query.u.type_1 = RPNquery;
-        printf ("- RPN\n");
+        printf ("- CCLRPN\n");
     }
+#endif
     else if (!strcmp (p->set_inher.queryType, "ccl"))
     {
         query.which = Z_Query_type_2;
@@ -1267,6 +1290,7 @@ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp,
     return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv);
 }
 
+#if 0
 static int get_marc_fields(Tcl_Interp *interp, Iso2709Rec rec,
                            int argc, char **argv)
 {
@@ -1287,7 +1311,9 @@ static int get_marc_fields(Tcl_Interp *interp, Iso2709Rec rec,
     iso2709_a_rm (a);
     return TCL_OK;
 }
+#endif
 
+#if 0
 static int get_marc_lines(Tcl_Interp *interp, Iso2709Rec rec,
                          int argc, char **argv)
 {
@@ -1329,6 +1355,7 @@ static int get_marc_lines(Tcl_Interp *interp, Iso2709Rec rec,
     iso2709_a_rm (a);
     return TCL_OK;
 }
+#endif
 
 /*
  * do_recordType: Return record type (if any) at position.
@@ -1397,9 +1424,9 @@ static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv)
 }
 
 /*
- * do_recordMarc: Get ISO2709 Record lines/fields
+ * do_getMarc: Get ISO2709 Record lines/fields
  */
-static int do_recordMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
+static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
     IRSetObj *obj = o;
     int offset;
@@ -1423,15 +1450,7 @@ static int do_recordMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
         Tcl_AppendResult (interp, "No MARC record at #", argv[2], NULL);
         return TCL_ERROR;
     }
-    if (!strcmp (argv[3], "field"))
-        return get_marc_fields (interp, rl->u.marc.rec, argc, argv);
-    else if (!strcmp (argv[3], "line"))
-        return get_marc_lines (interp, rl->u.marc.rec, argc, argv);
-    else
-    {
-        Tcl_AppendResult (interp, "field/line expected", NULL);
-        return TCL_ERROR;
-    }
+    return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv);
 }
 
 
@@ -1544,8 +1563,9 @@ static int do_loadFile (void *o, Tcl_Interp *interp,
 {
     IRSetObj *setobj = o;
     FILE *inf;
+    size_t size;
     int  no = 1;
-    const char *buf;
+    char *buf;
 
     if (argc < 3)
     {
@@ -1558,16 +1578,13 @@ static int do_loadFile (void *o, Tcl_Interp *interp,
         Tcl_AppendResult (interp, "Cannot open ", argv[2], NULL);
         return TCL_ERROR;
     }
-    while ((buf = iso2709_read (inf)))
+    while ((buf = ir_tcl_fread_marc (inf, &size)))
     {
         IRRecordList *rl;
-        Iso2709Rec rec;
 
-        rec = iso2709_cvt (buf);
-        if (!rec)
-            break;
         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord);
-        rl->u.marc.rec = rec;
+        rl->u.dbrec.buf = buf;
+	rl->u.dbrec.size = size;
         no++;
     }
     setobj->numberOfRecordsReturned = no-1;
@@ -1589,7 +1606,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp,
     { 0, "numberOfRecordsReturned", do_numberOfRecordsReturned },
     { 0, "present",                 do_present },
     { 0, "recordType",              do_recordType },
-    { 0, "recordMarc",              do_recordMarc },
+    { 0, "getMarc",                 do_getMarc },
     { 0, "recordDiag",              do_recordDiag },
     { 0, "responseStatus",          do_responseStatus },
     { 0, "loadFile",                do_loadFile },
@@ -1691,8 +1708,11 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     Z_APDU apdu, *apdup = &apdu;
     IRScanObj *obj = o;
     IRObj *p = obj->parent;
-    int r, pos;
+    int r;
+#if CCL2RPN
     struct ccl_rpn_node *rpn;
+    int pos;
+#endif
 
     p->scan_child = o;
     if (argc != 3)
@@ -1717,25 +1737,12 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     req.databaseNames = p->set_inher.databaseNames;
     req.attributeSet = oid_getoidbyent (&p->bib1);
 
-#if 0
-    if (!(req.termListAndStartPoint =
-          ir_malloc (interp, sizeof(*req.termListAndStartPoint))))
-        return TCL_ERROR;
-    req.termListAndStartPoint->num_attributes = 0;
-    req.termListAndStartPoint->attributeList = NULL;
-    if (!(req.termListAndStartPoint->term = ir_malloc (interp,
-                                                       sizeof(Z_Term))))
-        return TCL_ERROR;
-    req.termListAndStartPoint->term->which = Z_Term_general;
-    if (!(req.termListAndStartPoint->term->u.general = 
-        ir_malloc (interp, sizeof(*req.termListAndStartPoint->
-                                  term->u.general))))
-        return TCL_ERROR;
-    if (ir_strdup (interp, &req.termListAndStartPoint->term->u.general->buf,
-                   argv[2]) == TCL_ERROR)
-        return TCL_ERROR;
-    req.termListAndStartPoint->term->u.general->len = 
-        req.termListAndStartPoint->term->u.general->size = strlen(argv[2]);
+#if !CCL2RPN
+    if (!(req.termListAndStartPoint = p_query_scan (p->odr_out, argv[2])))
+    {
+        Tcl_AppendResult (interp, "Syntax error in query", NULL);
+	return TCL_ERROR;
+    }
 #else
     rpn = ccl_find_str(p->bibset, argv[2], &r, &pos);
     if (r)
@@ -2050,14 +2057,15 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
                     ->u.databaseRecord;
                 oe = (Odr_external*) zr;
-                if (oe->which == ODR_EXTERNAL_octet
-                    && zr->u.octet_aligned->len)
+		rl->u.dbrec.size = zr->u.octet_aligned->len;
+                if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
                 {
                     const char *buf = (char*) zr->u.octet_aligned->buf;
-                    rl->u.marc.rec = iso2709_cvt (buf);
+                    if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size)))
+		        memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
                 }
                 else
-                    rl->u.marc.rec = NULL;
+                    rl->u.dbrec.buf = NULL;
             }
         }
     }
diff --git a/ir-tclp.h b/ir-tclp.h
index 2ba4090..21d9ae4 100644
--- a/ir-tclp.h
+++ b/ir-tclp.h
@@ -4,7 +4,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tclp.h,v $
- * Revision 1.2  1995-05-24 14:10:23  adam
+ * Revision 1.3  1995-05-26 08:54:17  adam
+ * New MARC utilities. Uses prefix query.
+ *
+ * Revision 1.2  1995/05/24  14:10:23  adam
  * Work on idAuthentication, protocolVersion and options.
  *
  * Revision 1.1  1995/05/23  15:34:49  adam
@@ -19,8 +22,14 @@
 
 #include <tcl.h>
 
+#include <pquery.h>
+#if CCL2RPN
 #include <yaz-ccl.h>
+#endif
+#if 0
 #include <iso2709.h>
+#endif
+
 #include <comstack.h>
 #include <tcpip.h>
 
@@ -87,7 +96,10 @@ typedef struct {
     char       *callback;
     char       *failback;
 
+#if CCL2RPN
     CCL_bibset  bibset;
+#endif
+
     oident      bib1;
 
     struct IRSetObj_ *set_child;
@@ -101,8 +113,9 @@ typedef struct IRRecordList_ {
     int which;
     union {
         struct {
-            Iso2709Rec rec;
-        } marc;
+	    char *buf;
+	    size_t size;
+        } dbrec;
         struct {
             int  condition;
             char *addinfo;
@@ -169,4 +182,8 @@ struct ir_named_entry {
     char *name;
     int  pos;
 };
+
+int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
+                     int argc, char **argv);
+char *ir_tcl_fread_marc (FILE *inf, size_t *size);
 #endif
diff --git a/marc.c b/marc.c
new file mode 100644
index 0000000..04d497f
--- /dev/null
+++ b/marc.c
@@ -0,0 +1,257 @@
+/*
+ * IR toolkit for tcl/tk
+ * (c) Index Data 1995
+ * Sebastian Hammer, Adam Dickmeiss
+ *
+ * $Log: marc.c,v $
+ * Revision 1.1  1995-05-26 08:54:19  adam
+ * New MARC utilities. Uses prefix query.
+ *
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <ctype.h>
+#include <assert.h>
+
+#include "ir-tclp.h"
+
+#define ISO2709_RS 035
+#define ISO2709_FS 036
+#define ISO2709_IDFS 037
+
+int atoi_n (const char *buf, int len)
+{
+    int val = 0;
+
+    while (--len >= 0)
+    {
+        if (isdigit (*buf))
+            val = val*10 + (*buf - '0');
+	buf++;
+    }
+    return val;
+}
+
+static int marc_compare (const char *f, const char *p)
+{
+    if (*p == '*')
+        return 0;
+    if (!f)
+        return -*p;
+    for (; *f && *p; f++, p++)
+    {
+        if (*p == '?')
+	    continue;
+	if (*p != *f)
+	    break;
+    }
+    return *f - *p;
+}
+
+FILE *outf = stderr;
+
+char *ir_tcl_fread_marc (FILE *inf, size_t *size)
+{
+    char length[5];
+    char *buf;
+
+    if (fread (length, 1, 5, inf) != 5)
+        return NULL;
+    *size = atoi_n (length, 5);
+    if (*size <= 6)
+        return NULL;
+    if (!(buf = malloc (*size+1)))
+        return NULL;
+    if (fread (buf+5, 1, *size-5, inf) != (*size-5))
+    {
+        free (buf);
+	return NULL;
+    }
+    memcpy (buf, length, 5);
+    buf[*size=0] = '\0';
+    return buf;
+}
+
+int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf, 
+                     int argc, char **argv)
+{
+    int entry_p;
+    int record_length;
+    int indicator_length;
+    int identifier_length;
+    int base_address;
+    int length_data_entry;
+    int length_starting;
+    int length_implementation;
+    int mode = 0;
+
+    if (!strcmp (argv[3], "field"))
+        mode = 'f';
+    else if (!strcmp (argv[3], "lines"))
+        mode = 'l';
+    else
+    {
+        Tcl_AppendResult (interp, "Unknown MARC extract mode", NULL);
+	return TCL_ERROR;
+    }
+    record_length = atoi_n (buf, 5);
+    if (record_length < 25)
+    {
+        Tcl_AppendResult (interp, "Not a MARC record", NULL);
+        return TCL_ERROR;
+    }
+    indicator_length = atoi_n (buf+10, 1);
+    identifier_length = atoi_n (buf+11, 1);
+    base_address = atoi_n (buf+12, 4);
+
+    length_data_entry = atoi_n (buf+20, 1);
+    length_starting = atoi_n (buf+21, 1);
+    length_implementation = atoi_n (buf+22, 1);
+
+    for (entry_p = 24; buf[entry_p] != ISO2709_FS; )
+        entry_p += 3+length_data_entry+length_starting;
+    base_address = entry_p+1;
+    for (entry_p = 24; buf[entry_p] != ISO2709_FS; )
+    {
+        int data_length;
+	int data_offset;
+	int end_offset;
+	int i, j;
+	char tag[4];
+	char indicator[128];
+	char identifier[128];
+
+        memcpy (tag, buf+entry_p, 3);
+	entry_p += 3;
+        tag[3] = '\0';
+	data_length = atoi_n (buf+entry_p, length_data_entry);
+	entry_p += length_data_entry;
+	data_offset = atoi_n (buf+entry_p, length_starting);
+	entry_p += length_starting;
+	i = data_offset + base_address;
+	end_offset = i+data_length-1;
+	*indicator = '\0';
+        if (memcmp (tag, "00", 2) && indicator_length)
+	{
+            for (j = 0; j<indicator_length; j++)
+	        indicator[j] = buf[i++];
+	    indicator[j] = '\0';
+	}
+	if (marc_compare (tag, argv[4]) || marc_compare (indicator, argv[5]))
+	    continue;
+	while (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS && i < end_offset)
+	{
+            if (memcmp (tag, "00", 2) && identifier_length)
+	    {
+	        int i0;
+	        i++;
+                for (j = 1; j<identifier_length; j++)
+		    identifier[j-1] = buf[i++];
+		identifier[j-1] = '\0';
+	        for (i0 = i; buf[i] != ISO2709_RS && 
+		             buf[i] != ISO2709_IDFS &&
+	                     buf[i] != ISO2709_FS && i < end_offset; 
+			     i++)
+		    ;
+		if (marc_compare (identifier, argv[6])==0)
+		{
+                    char *data = malloc (i-i0+1);
+
+		    memcpy (data, buf+i0, i-i0);
+		    data[i-i0] = '\0';
+                    Tcl_AppendElement (interp, data);
+		    free (data);
+		}
+	    }
+	    else
+	    {
+	        int i0;
+
+	        for (i0 = i; buf[i] != ISO2709_RS && 
+	                     buf[i] != ISO2709_FS && i < end_offset; 
+			     i++)
+		    ;
+		if (marc_compare (NULL, argv[6])==0)
+		{
+                    char *data = malloc (i-i0+1);
+
+		    memcpy (data, buf+i0, i-i0);
+		    data[i-i0] = '\0';
+                    Tcl_AppendElement (interp, data);
+		    free (data);
+		}
+
+	    }
+	}
+	if (i < end_offset)
+	    fprintf (outf, "-- separator but not at end of field\n");
+	if (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS)
+	    fprintf (outf, "-- no separator at end of field\n");
+    }
+    return TCL_OK;
+}
+
+#if 0
+int ir_tcl_get_marc_fields(Tcl_Interp *interp, const char *buf,
+                           size_t size, int argc, char **argv)
+{
+    Iso2709Anchor a;
+    char *data;
+
+    if (!rec)
+        return TCL_OK;
+    a = iso2709_a_mk (rec);
+    while (iso2709_a_search (a, argv[4], argv[5], argv[6]))
+    {
+        if (!(iso2709_a_info_field (a, NULL, NULL, NULL, &data)))
+            break;
+        Tcl_AppendElement (interp, data);
+        iso2709_a_next (a);
+    }
+    iso2709_a_rm (a);
+    return TCL_OK;
+}
+
+int ir_tcl_get_marc_lines(Tcl_Interp *interp, const char *buf,
+                          size_t size, int argc, char **argv)
+{
+    Iso2709Anchor a;
+    char *tag;
+    char *indicator;
+    char *identifier;
+    char *data;
+    char *ptag = "";
+    
+    if (!rec)
+        return TCL_OK;
+    a = iso2709_a_mk (rec);
+    while (iso2709_a_search (a, argv[4], argv[5], argv[6]))
+    {
+        if (!(iso2709_a_info_field (a, &tag, &indicator, &identifier, &data)))
+            break;
+        if (strcmp (tag, ptag))
+        {
+            if (*ptag)
+                Tcl_AppendResult (interp, "}} ", NULL);
+            if (!indicator)
+                Tcl_AppendResult (interp, "{", tag, " {} {", NULL);
+            else
+                Tcl_AppendResult (interp, "{", tag, " {", indicator, 
+                                  "} {", NULL);
+            ptag = tag;
+        }
+        if (!identifier)
+            Tcl_AppendResult (interp, "{{}", NULL);
+        else
+            Tcl_AppendResult (interp, "{", identifier, NULL);
+        Tcl_AppendElement (interp, data);
+        Tcl_AppendResult (interp, "} ", NULL);
+        iso2709_a_next (a);
+    }
+    if (*ptag)
+        Tcl_AppendResult (interp, "}} ", NULL);
+    iso2709_a_rm (a);
+    return TCL_OK;
+}
+#endif