From: Adam Dickmeiss <adam@indexdata.dk>
Date: Thu, 2 Mar 1995 08:06:03 +0000 (+0000)
Subject: Fml function strsub implemented. New test files marc[45].fml.
X-Git-Url: http://sru.miketaylor.org.uk/cgi-bin?a=commitdiff_plain;h=6e62fd0ea79a0e717eb3200533e234db3549cb01;p=egate.git

Fml function strsub implemented. New test files marc[45].fml.
New test options in fmltest.
---

diff --git a/fml/fmlmem.c b/fml/fmlmem.c
index eabd8ad..f65fc79 100644
--- a/fml/fmlmem.c
+++ b/fml/fmlmem.c
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlmem.c,v $
- * Revision 1.9  1995/02/27 09:01:20  adam
+ * Revision 1.10  1995/03/02 08:06:03  adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.9  1995/02/27  09:01:20  adam
  * Regular expression support. Argument passing by name option. New FML
  * function strlen.
  *
@@ -277,3 +281,26 @@ void fml_node_stat (Fml fml)
     if (fml->debug & 2)
         printf ("<<node=%d, atom=%d>>", no_nodes, no_atoms);
 }
+
+struct fml_atom *fml_atom_strsub (Fml fml, struct fml_atom *a, int o, int l)
+{
+    static char buf[512];
+    char *cp;
+    struct fml_atom *an;
+    int ol = fml_atom_len (a);
+
+    if (ol >= 510)
+    {
+        cp = malloc (ol + 1);
+        assert (cp);
+    }
+    else
+        cp = buf;
+    fml_atom_str (a, buf);
+    if (o + l < ol)
+        buf[o+l] = '\0';
+    an = fml_atom_alloc (fml, buf+o);
+    if (ol >= 510)
+        free (cp);
+    return an;
+}
diff --git a/fml/fmlp.h b/fml/fmlp.h
index f8c9c7a..6c02326 100644
--- a/fml/fmlp.h
+++ b/fml/fmlp.h
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlp.h,v $
- * Revision 1.11  1995/02/27 09:01:21  adam
+ * Revision 1.12  1995/03/02 08:06:05  adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.11  1995/02/27  09:01:21  adam
  * Regular expression support. Argument passing by name option. New FML
  * function strlen.
  *
@@ -75,6 +79,7 @@ void fml_node_delete (Fml fml, struct fml_node *fn);
 struct fml_node *fml_node_copy (Fml fml, struct fml_node *fn);
 struct fml_node *fml_mk_node_val (Fml fml, int val);
 int fml_atom_cmp (Fml fml, struct fml_atom *a1, struct fml_atom *a2);
+struct fml_atom *fml_atom_strsub (Fml fml, struct fml_atom *a, int o, int l);
 
 struct token {
     int             kind;
diff --git a/fml/fmlstr.c b/fml/fmlstr.c
index c8810a0..2bfda57 100644
--- a/fml/fmlstr.c
+++ b/fml/fmlstr.c
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlstr.c,v $
- * Revision 1.4  1995/02/27 09:01:21  adam
+ * Revision 1.5  1995/03/02 08:06:07  adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.4  1995/02/27  09:01:21  adam
  * Regular expression support. Argument passing by name option. New FML
  * function strlen.
  *
@@ -145,6 +149,39 @@ static struct fml_node *fml_exec_strlen (Fml fml, struct fml_node **lp,
     return fml_mk_node_val (fml, len);
 }
 
+static struct fml_node *fml_exec_strsub (Fml fml, struct fml_node **lp,
+					 struct token *tp)
+{
+    struct fml_node *fn_str;
+    struct fml_node *fn_offset;
+    struct fml_node *fn_length;
+    struct fml_node *fn_res;
+    int offset, length;
+
+    fml_cmd_lex (lp, tp);
+    fn_str = fml_expr_term (fml, lp, tp);
+    fn_offset = fml_expr_term (fml, lp, tp);
+    fn_length = fml_expr_term (fml, lp, tp);
+    if (!fn_offset->is_atom || !fn_length->is_atom || !fn_str->is_atom)
+    {
+        fml_node_delete (fml, fn_str);
+        fml_node_delete (fml, fn_offset);
+        fml_node_delete (fml, fn_length);
+        return NULL;
+    }
+    offset = fml_atom_val (fn_offset->p[0]);
+    fml_node_delete (fml, fn_offset);
+    length = fml_atom_val (fn_length->p[0]);
+    fml_node_delete (fml, fn_length);
+    if (offset == 0 && fml_atom_len (fn_str->p[0]) < length)
+        return fn_str;
+    fn_res = fml_node_alloc (fml);
+    fn_res->is_atom = 1;
+    fn_res->p[0]= fml_atom_strsub (fml, fn_str->p[0], offset, length);
+    fml_node_delete (fml, fn_str);
+    return fn_res;
+}
+
 static struct fml_node *fml_exec_strcmp (Fml fml, struct fml_node **lp, 
                                          struct token *tp)
 {
@@ -183,6 +220,9 @@ void fml_str_init (Fml fml)
     sym_info = fml_sym_add (fml->sym_tab, "strlen");
     sym_info->kind = FML_CPREFIX;
     sym_info->prefix = fml_exec_strlen;
+    sym_info = fml_sym_add (fml->sym_tab, "strsub");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_strsub;
 #if USE_GNU_REGEX
     sym_info = fml_sym_add (fml->sym_tab, "match");
     sym_info->kind = FML_CPREFIX;
diff --git a/fml/fmlsym.c b/fml/fmlsym.c
index e54419f..f6739e9 100644
--- a/fml/fmlsym.c
+++ b/fml/fmlsym.c
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlsym.c,v $
- * Revision 1.3  1995/02/23 08:32:06  adam
+ * Revision 1.4  1995/03/02 08:06:09  adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.3  1995/02/23  08:32:06  adam
  * Changed header.
  *
  * Revision 1.1.1.1  1995/02/06  13:48:10  adam
@@ -16,19 +20,48 @@
 
 #include "fmlp.h"
 
+#define SYM_CHUNK 128
+
 struct fml_sym {
     struct fml_sym_info info;
     struct fml_sym *next;
     int level;
     char *name;
+    struct fml_sym *level_link;
 };
 
 struct fml_sym_tab {
     int level;
     int hash;
     struct fml_sym **array;
+    struct fml_sym *level_link_0;
+    struct fml_sym *level_link_n;
+    struct fml_sym *free_list;
 };
 
+static struct fml_sym *sym_alloc (struct fml_sym_tab *tab) 
+{
+    struct fml_sym *p = tab->free_list;
+    if (!p)
+    {
+        int i;
+
+    	tab->free_list = p = malloc (sizeof(*p) * SYM_CHUNK);
+    	assert (p);
+    	for (i = 0; i<SYM_CHUNK-1; i++)
+            p[i].next = p+i+1;
+        p[i].next = NULL;
+    }
+    tab->free_list = p->next;
+    return p;
+}
+
+static void sym_release (struct fml_sym_tab *tab, struct fml_sym *p)
+{
+    p->next = tab->free_list;
+    tab->free_list = p;
+}
+
 struct fml_sym_tab *fml_sym_open (void)
 {
     struct fml_sym_tab *tab;
@@ -38,7 +71,10 @@ struct fml_sym_tab *fml_sym_open (void)
     if (!tab)
         return NULL;
     tab->level = 1;
-    tab->hash = 101;
+    tab->level_link_0 = NULL;
+    tab->level_link_n = NULL;
+    tab->free_list = NULL;
+    tab->hash = 41;
     tab->array = malloc (sizeof(*tab->array) * tab->hash);
     if (!tab->array)
     {
@@ -90,7 +126,7 @@ void fml_sym_pop (struct fml_sym_tab *tab, void (*ph)(struct fml_sym_info *i))
                     (*ph)(&fs->info);
                 *fsp = (*fsp)->next;
                 free (fs->name);
-                free (fs);
+                sym_release (tab, fs);
             }
             else
                 fsp = &(*fsp)->next;
@@ -120,17 +156,23 @@ static struct fml_sym_info *sym_add (struct fml_sym_tab *tab,
         return NULL;
     strcpy (cp, s);
 
-    sym = malloc (sizeof (*sym));
-    if (!sym)
-    {
-        free (cp);
-        return NULL;
-    }
+    sym = sym_alloc (tab);
+
     sym_entry = tab->array + fml_sym_hash (s, tab->hash);
     sym->name = cp;
     sym->next = *sym_entry;
     *sym_entry = sym;
     sym->level = level;
+    if (level)
+    {
+	sym->level_link = tab->level_link_n;
+	tab->level_link_n = sym;
+    }
+    else
+    {
+	sym->level_link = tab->level_link_0;
+	tab->level_link_0 = sym;
+    }
     return &sym->info;
 }
 
diff --git a/fml/fmltest.c b/fml/fmltest.c
index 3b7d7d7..7664473 100644
--- a/fml/fmltest.c
+++ b/fml/fmltest.c
@@ -2,7 +2,11 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmltest.c,v $
- * Revision 1.7  1995/02/23 08:32:06  adam
+ * Revision 1.8  1995/03/02 08:06:10  adam
+ * Fml function strsub implemented. New test files marc[45].fml.
+ * New test options in fmltest.
+ *
+ * Revision 1.7  1995/02/23  08:32:06  adam
  * Changed header.
  *
  * Revision 1.5  1995/02/10  15:50:56  adam
@@ -36,6 +40,7 @@
 
 #include <fmlmarc.h>
 
+char *prog;
 static FILE *inf;
 
 static int inf_read (void)
@@ -47,9 +52,13 @@ int main (int argc, char **argv)
 {
     Fml fml;
     int nfiles = 0;
+    int marc_show = 0;
     int interactive = 0;
-    Iso2709Rec rec = NULL;
+    const char *iso2709_fname = NULL;
+    const char *format_func = NULL;
+    int number_of_records = 10000;
 
+    prog = *argv;
     fml = fml_open ();
     while (-- argc > 0)
     {
@@ -62,32 +71,29 @@ int main (int argc, char **argv)
                 fml->debug |= 2;
             else if (argv[0][1] == 'i')
                 interactive = 1;
+            else if (argv[0][1] == 's')
+                marc_show = 1;
+            else if (argv[0][1] == 'n')
+            {
+            	if (argc > 1)
+            	{
+            	    number_of_records = atoi (*++argv);
+          	    --argc;
+          	}
+            }
             else if (argv[0][1] == '2')
             {
-                if (argc > 1)
+                if (argc > 2)
                 {
-                    char *buf;
-                    FILE *inf;
-                    ++argv;
+	    	    iso2709_fname = *++argv;
+	    	    --argc;
+	    	    format_func = *++argv;
                     --argc;
-
-                    inf = fopen (*argv, "r");
-                    if (!inf)
-                    {
-                        fprintf (stderr, "cannot open record `%s'\n", *argv);
-                        exit (1);
-                    }
-                    if ((buf = iso2709_read (inf)))
-                    {
-                        rec = iso2709_cvt (buf);
-                        free (buf);
-                    }
-                    else
-                    {
-                        fprintf (stderr, "no record in `%s'\n", *argv);
-                        exit (1);
-                    }
-                    fclose (inf);
+                }
+                else
+                {
+                    fprintf (stderr, "missing marcfile and format\n");
+                    exit (1);
                 }
             }
             else
@@ -116,6 +122,37 @@ int main (int argc, char **argv)
         fml_preprocess (fml);
         fml_exec (fml);
     }
+    else if (iso2709_fname)
+    {
+    	FILE *inf;
+	char *buf;
+        const char *nargv[5];
+        Iso2709Rec rec;
+        int no = 0;
+
+	inf = fopen (iso2709_fname, "r");
+	if (!inf)
+	{
+	    fprintf (stderr, "cannot open %s\n", iso2709_fname);
+	    exit (1);
+	}
+	while (no < number_of_records && (buf = iso2709_read (inf)))
+	{
+	    rec = iso2709_cvt (buf);
+	    free (buf);
+  	    nargv[0] = "\\";
+	    nargv[1] = format_func;
+	    nargv[2] = " \\list";
+	    nargv[4] = NULL;
+	    nargv[3]= marc_to_str (fml, rec);
+	    if (marc_show)
+	        printf ("\n[%s]\n", nargv[3]);
+	    iso2709_rm (rec);
+            fml_exec_call_argv (fml, nargv);
+            no++;
+	}
+	fclose (inf);
+    }
     else
     {
         if (interactive)
@@ -134,19 +171,8 @@ int main (int argc, char **argv)
                     break;
                 if ((cp = strchr (arg, '\n')))
                     *cp = '\0';
-                if (*arg == '!' && rec)
-                {
-                    nargv[0] = arg+1;
-                    nargv[1] = " ";
-                    nargv[2] = marc_to_str (fml, rec);
-                    printf ("passing '%s'\n", nargv[2]);
-                    nargv[3] = NULL;
-                }
-                else
-                {
-                    nargv[0] = arg;
-                    nargv[1] = NULL;
-                }
+                nargv[0] = arg;
+                nargv[1] = NULL;
                 fml_exec_call_argv (fml, nargv);
             }
         }
diff --git a/fml/marc4.fml b/fml/marc4.fml
new file mode 100644
index 0000000..544538d
--- /dev/null
+++ b/fml/marc4.fml
@@ -0,0 +1,70 @@
+# FML marc rutines - with passing of code and regular expressions
+#
+# $Id: marc4.fml,v 1.1 1995/03/02 08:06:11 adam Exp $
+\func case tag indicator identifier \code max {
+	\if {\match \tag {\line\index 1}} {
+	\if {\match \indicator {\line\index 2}} {
+		\foreach field {\line \index 3} {
+			\if{\match \identifier \field\index 1} {
+				\set info {\field \index 2}
+				\if {{\strlen \info}\gt \max}
+				{
+					\set info {\strsub \info 0 50 ..}
+				}
+				\code
+			}
+		}
+	} }
+}
+
+\func casx tag identifier \pre \mid \end {
+	\set no {}
+	\if {\match \tag {\line\index 1}} {
+		\foreach field {\line \index 3} {
+			\if {\match \identifier \field\index 1} {
+				\set info {\field \index 2}
+				\if {\no} {
+					\mid
+					\incr \no
+				}
+				\else {
+					\set no 1
+					\pre
+				}
+			}
+		}
+	} 
+	\if {\no} {
+		\end
+	}
+}
+
+\func marc rec \code {
+	\foreach line {\rec} {\code}
+}
+
+\func f0 record {
+	\marc {\record} {
+		\case 245 .. [a] { \info } 60
+		\case 260 .. c { - \info} 9
+	}
+	\n
+}
+
+\func f1 record {
+	\marc {\record} {
+		\case 245 .. [ab] {\info\ } 400
+		\casx 260 [abc] {\n\ \ \info} {\ \info} {}
+		\casx 300 [ab] {- \info} {\ \info} {}
+	}
+	\n
+	\marc {\record} {
+		\casx 700 a {\info} {\ ,\info} {\n}
+	}
+	\marc {\record} {
+		\case 020 .. a {ISBN: \info\n} 50
+		\case 022 .. a {ISSN: \info\n} 50
+		\casx 050 [ab] {LC: \info} {\info} {\n}
+	}
+	\n
+}
diff --git a/fml/marc5.fml b/fml/marc5.fml
new file mode 100644
index 0000000..a9cdf96
--- /dev/null
+++ b/fml/marc5.fml
@@ -0,0 +1,70 @@
+# FML marc rutines - with passing of code and regular expressions
+#
+# $Id: marc5.fml,v 1.1 1995/03/02 08:06:12 adam Exp $
+\func case tag indicator identifier \code max {
+	\if {\match \tag {\line\index 1}} {
+	\if {\match \indicator {\line\index 2}} {
+		\foreach field {\line \index 3} {
+			\if{\match \identifier \field\index 1} {
+				\set info {\field \index 2}
+				\if {{\strlen \info}\gt \max}
+				{
+					\set info {\strsub \info 0 50 ..}
+				}
+				\code
+			}
+		}
+	} }
+}
+
+\func casx tag identifier \pre \mid \end {
+	\set no {}
+	\if {\match \tag {\line\index 1}} {
+		\foreach field {\line \index 3} {
+			\if {\match \identifier \field\index 1} {
+				\set info {\field \index 2}
+				\if {\no} {
+					\mid
+					\incr \no
+				}
+				\else {
+					\set no 1
+					\pre
+				}
+			}
+		}
+	} 
+	\if {\no} {
+		\end
+	}
+}
+
+\func marc rec \code {
+	\foreach line {\rec} {\code}
+}
+
+\func f0 record {
+	\marc {\record} {
+		\case 245 .. [a] { \info } 60
+		\case 260 .. c { - \info} 9
+	}
+	\n
+}
+
+\func f1 record {
+	\foreach line {\record} {
+		\case 245 .. [ab] {\info\ } 400
+		\casx 260 [abc] {\n\ \ \info} {\ \info} {}
+		\casx 300 [ab] {- \info} {\ \info} {}
+	}
+	\n
+	\foreach line {\record} {
+		\casx 700 a {\info} {\ ,\info} {\n}
+	}
+	\foreach line {\record} {
+		\case 020 .. a {ISBN: \info\n} 50
+		\case 022 .. a {ISSN: \info\n} 50
+		\casx 050 [ab] {LC: \info} {\info} {\n}
+	}
+	\n
+}