1.4.
[ir-tcl-moved-to-github.git] / marc.c
diff --git a/marc.c b/marc.c
index 9320d40..8bbb69c 100644 (file)
--- a/marc.c
+++ b/marc.c
@@ -5,7 +5,24 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: marc.c,v $
- * Revision 1.5  1995-06-30 12:39:26  adam
+ * Revision 1.10  1999-02-08 09:22:31  franck
+ * Added a grs mode for ir_tcl_get_marc which returns MARC records in a TCL
+ * structure similar to that of ir_tcl_get_grs.
+ *
+ * Revision 1.9  1996/07/03 13:31:13  adam
+ * The xmalloc/xfree functions from YAZ are used to manage memory.
+ *
+ * Revision 1.8  1995/11/14  16:48:00  adam
+ * Bug fix: record extraction in line mode merged lines with same tag.
+ *
+ * Revision 1.7  1995/11/09  15:24:02  adam
+ * Allow charsets [..] in record match.
+ *
+ * Revision 1.6  1995/08/28  12:21:22  adam
+ * Removed lines and list as synonyms of list in MARC extractron.
+ * Configure searches also for tk4.0 / tcl7.4.
+ *
+ * Revision 1.5  1995/06/30  12:39:26  adam
  * Bug fix: loadFile didn't set record type.
  * The MARC routines are a little less strict in the interpretation.
  * Script display.tcl replaces the old marc.tcl.
@@ -56,18 +73,39 @@ static int atoi_n (const char *buf, int len)
 
 static int marc_compare (const char *f, const char *p)
 {
+    int ch;
+
     if (*p == '*')
         return 0;
     if (!f)
         return -*p;
-    for (; *f && *p; f++, p++)
-    {
-        if (*p == '?')
-           continue;
-       if (*p != *f)
-           break;
-    }
-    return *f - *p;
+    for (; (ch = *p) && *f; f++, p++)
+        switch (*p)
+        {
+        case '*':
+            return 0;
+        case '?':
+            ch = *f;
+            break;
+        case '[':
+            while (1)
+                if (!*++p)
+                    break;
+                else if (*p == ']')
+                {
+                    p++;
+                    break;
+                }
+                else if (*p == *f)
+                    ch = *p;
+            if (ch != *p)
+                return *f - ch;
+            break;
+        default:
+            if (ch != *f)
+                return *f - ch;
+        }
+    return *f - ch;
 }
 
 char *ir_tcl_fread_marc (FILE *inf, size_t *size)
@@ -80,11 +118,11 @@ char *ir_tcl_fread_marc (FILE *inf, size_t *size)
     *size = atoi_n (length, 5);
     if (*size <= 6)
         return NULL;
-    if (!(buf = malloc (*size+1)))
+    if (!(buf = xmalloc (*size+1)))
         return NULL;
     if (fread (buf+5, 1, *size-5, inf) != (*size-5))
     {
-        free (buf);
+        xfree (buf);
        return NULL;
     }
     memcpy (buf, length, 5);
@@ -106,11 +144,12 @@ int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
     char ptag[4];
     int mode = 0;
 
-    *ptag = '\0';
     if (!strcmp (argv[3], "field"))
         mode = 'f';
-    else if (!strcmp (argv[3], "lines") || !strcmp (argv[3], "list"))
+    else if (!strcmp (argv[3], "line"))
         mode = 'l';
+    else if (!strcmp (argv[3], "grs"))
+        mode = 'g';
     else
     {
         Tcl_AppendResult (interp, "Unknown MARC extract mode", NULL);
@@ -148,6 +187,7 @@ int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
        char indicator[128];
        char identifier[128];
 
+        *ptag = '\0';
         memcpy (tag, buf+entry_p, 3);
        entry_p += 3;
         tag[3] = '\0';
@@ -192,7 +232,7 @@ int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
            }
             if (marc_compare (identifier, argv[6])==0)
             {
-                char *data = malloc (i-i0+1);
+                char *data = xmalloc (i-i0+1);
              
                 memcpy (data, buf+i0, i-i0);
                 data[i-i0] = '\0';
@@ -216,18 +256,41 @@ int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
                     Tcl_AppendElement (interp, data);
                     Tcl_AppendResult (interp, "} ", NULL);
                 }
+                else if (mode == 'g')
+                {
+                    if (strcmp (tag, ptag))
+                    {
+                        if (*ptag)
+                            Tcl_AppendResult (interp, "}} ", NULL);
+                        if (*indicator)
+                            Tcl_AppendResult (interp, "{ 0 numeric {", tag,
+                                              indicator, "} subtree {", NULL);
+                        else
+                            Tcl_AppendResult (interp, "{ 0 numeric ", tag,
+                                              " subtree {", NULL);
+                        strcpy (ptag, tag);
+                    }
+                    if (*identifier)
+                        Tcl_AppendResult (interp, "{3 string ", identifier,
+                                          " string ", NULL);
+                    else
+                        Tcl_AppendResult (interp, "{1 numeric 19 string ",
+                                          NULL);
+                    Tcl_AppendElement (interp, data);
+                    Tcl_AppendResult (interp, "} ", NULL);
+                }
                 else
                     Tcl_AppendElement (interp, data);
-                free (data);
+                xfree (data);
             }
        }
+        if (((mode == 'l') || (mode == 'g')) && *ptag)
+            Tcl_AppendResult (interp, "}} ", NULL);
        if (i < end_offset)
             logf (LOG_WARN, "MARC: separator but not at end of field");
        if (buf[i] != ISO2709_RS && buf[i] != ISO2709_FS)
             logf (LOG_WARN, "MARC: no separator at end of field");
     }
-    if (mode == 'l' && *ptag)
-        Tcl_AppendResult (interp, "}} ", NULL);
     return TCL_OK;
 }