MARC interface implemented. Minor bugs fixed. fmltest can
authorAdam Dickmeiss <adam@indexdata.dk>
Fri, 10 Feb 1995 15:50:54 +0000 (15:50 +0000)
committerAdam Dickmeiss <adam@indexdata.dk>
Fri, 10 Feb 1995 15:50:54 +0000 (15:50 +0000)
be used to format single MARC records. New function '\list'
implemented.

fml/Makefile
fml/fml.c
fml/fml.h
fml/fmlcalls.c
fml/fmllist.c
fml/fmlmarc.c [new file with mode: 0644]
fml/fmlmarc.h [new file with mode: 0644]
fml/fmlp.h
fml/fmltest.c
fml/fmltoken.c
fml/marc.fml [new file with mode: 0644]

index db2b779..aa499a5 100644 (file)
@@ -1,15 +1,15 @@
 # FML interpreter. Europagate, 1995
 #
-# $Id: Makefile,v 1.3 1995/02/09 16:06:04 adam Exp $
+# $Id: Makefile,v 1.4 1995/02/10 15:50:54 adam Exp $
 
 SHELL=/bin/sh
-INCLUDE=-I../include
+INCLUDE=-I../egate/include -I.
 TPROG1=fmltest
 CFLAGS=-g -Wall -pedantic 
 DEFS=$(INCLUDE)
 LIB=fml.a 
 PO = fmltoken.o fmlmem.o fml.o fmlsym.o fmlrel.o fmlarit.o fmllist.o \
-fmlcall.o fmlcalls.o
+fmlcall.o fmlcalls.o fmlmarc.o
 
 CPP=cc -E
 CC=gcc
@@ -17,7 +17,7 @@ CC=gcc
 all: $(LIB) $(TPROG1) $(TPROG2)
 
 $(TPROG1): $(TPROG1).o $(LIB) 
-       $(CC) $(CFLAGS) -o $(TPROG1) $(TPROG1).o $(LIB)
+       $(CC) $(CFLAGS) -o $(TPROG1) $(TPROG1).o $(LIB) ../egate/lib/util.a
 
 $(LIB): $(PO)
        rm -f $(LIB)
index 9423b95..d5f5af3 100644 (file)
--- a/fml/fml.c
+++ b/fml/fml.c
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fml.c,v $
- * Revision 1.6  1995/02/09 16:06:06  adam
+ * Revision 1.7  1995/02/10 15:50:54  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.6  1995/02/09  16:06:06  adam
  * FML can be called from the outside multiple times by the functions:
  * fml_exec_call and fml_exec_call_str.
  * An interactive parameter (-i) to fmltest starts a shell-like
@@ -281,7 +286,10 @@ static struct fml_node *fml_exec_space (Fml fml, struct fml_node **lp,
                                         struct token *tp)
 {
     fml_cmd_lex (lp, tp);
-    putchar ('_');
+    if (fml->debug & 1)
+        putchar ('_');
+    else
+        putchar (' ');
     return NULL;
 }
 
@@ -358,7 +366,7 @@ static void fml_emit (struct fml_node *list)
                 printf (" ");
             s++;
             for (a = list->p[0]; a; a=a->next)
-                printf ("%s", a->buf);
+                printf ("%.*s", FML_ATOM_BUF, a->buf);
         }
         else
             fml_emit (list->p[0]);
@@ -387,7 +395,6 @@ static struct fml_node *fml_sub2 (Fml fml, struct fml_node **lp,
             break;
         case FML_CPREFIX:
             fn = (*info->prefix) (fml, lp, tp);
-            fml_cmd_lex (lp, tp);
             break;
         default:
             fml_cmd_lex (lp, tp);
@@ -567,8 +574,9 @@ static struct fml_node *fml_exec_foreach (struct fml_sym_info *info, Fml fml,
     }
     else
     {
-        fml_node_delete (fml, info->body);
-        info->body = NULL;
+        if (info_var->kind == FML_VAR)
+            fml_node_delete (fml, info_var->body);
+        info_var->body = NULL;
     }
     if (fml->debug & 1)
     {
index 38dfd91..508b942 100644 (file)
--- a/fml/fml.h
+++ b/fml/fml.h
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fml.h,v $
- * Revision 1.2  1995/02/09 16:06:06  adam
+ * Revision 1.3  1995/02/10 15:50:55  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.2  1995/02/09  16:06:06  adam
  * FML can be called from the outside multiple times by the functions:
  * fml_exec_call and fml_exec_call_str.
  * An interactive parameter (-i) to fmltest starts a shell-like
@@ -14,6 +19,8 @@
  *
  */
 
+#ifndef FML_H
+#define FML_H
 typedef struct Fml_record {
     struct fml_node *list;
     struct fml_sym_tab *sym_tab;
@@ -37,6 +44,8 @@ int fml_preprocess (Fml fml);
 void fml_exec (Fml fml);
 void fml_exec_call (Fml fml);
 void fml_exec_call_str (Fml fml, const char *str);
+void fml_exec_call_argv (Fml fml, const char **argv);
 
 #define FML_ERR_NOMEM 1
 
+#endif
index 5e73f0e..b073e71 100644 (file)
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlcalls.c,v $
- * Revision 1.1  1995/02/09 16:06:07  adam
+ * Revision 1.2  1995/02/10 15:50:55  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.1  1995/02/09  16:06:07  adam
  * FML can be called from the outside multiple times by the functions:
  * fml_exec_call and fml_exec_call_str.
  * An interactive parameter (-i) to fmltest starts a shell-like
 
 #include "fmlp.h"
 
-static const char *str_ptr;
+static const char **str_args;
 static int eof_mark;
 static int str_reader (void)
 {
-    if (!*str_ptr)
-        return eof_mark;
-    return *str_ptr++;
+    int c;
+    while (! (c = **str_args))
+    {
+        if (! str_args[1])
+            return eof_mark;
+        ++str_args;
+    }   
+    ++ *str_args;
+    return c;
+}
+
+void fml_exec_call_argv (Fml fml, const char **argv)
+{
+    int (*old_func)(void) = fml->read_func;
+
+    fml->read_func = str_reader;
+    str_args = argv;
+    eof_mark = fml->eof_mark;
+    fml_exec_call (fml);
+    fml->read_func = old_func;
 }
 
+
 void fml_exec_call_str (Fml fml, const char *str)
 {
     int (*old_func)(void) = fml->read_func;
+    const char *argv[2];
+
+    argv[0] = str;
+    argv[1] = NULL;
 
     fml->read_func = str_reader;
-    str_ptr = str;
+    str_args = argv;
     eof_mark = fml->eof_mark;
     fml_exec_call (fml);
     fml->read_func = old_func;
 }
+
+
index 2d8b7ce..c44a074 100644 (file)
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmllist.c,v $
- * Revision 1.1  1995/02/09 14:33:37  adam
+ * Revision 1.2  1995/02/10 15:50:55  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.1  1995/02/09  14:33:37  adam
  * Split source fml.c and define relevant build-in functions in separate
  * files. New operators mult, div, not, llen implemented.
  *
@@ -83,6 +88,24 @@ static struct fml_node *fml_exec_len (Fml fml, struct fml_node **lp,
     return fn;
 }
 
+static struct fml_node *fml_exec_list (Fml fml, struct fml_node **lp,
+                                       struct token *tp)
+{
+    struct fml_node *fn = NULL;
+
+    fml_cmd_lex (lp, tp);
+    if (tp->kind == 'g')
+        fn = fml_node_copy (fml, tp->sub);
+    else
+    {
+        fn = fml_node_alloc (fml);
+        fn->is_atom = 1;
+        fn->p[0] = fml_atom_alloc (fml, tp->tokenbuf);
+    }
+    fml_cmd_lex (lp, tp);
+    return fn;
+}
+
 void fml_list_init (Fml fml)
 {
     struct fml_sym_info *sym_info;
@@ -94,4 +117,8 @@ void fml_list_init (Fml fml)
     sym_info = fml_sym_add (fml->sym_tab, "llen");
     sym_info->kind = FML_CPREFIX;
     sym_info->prefix = fml_exec_len;
+
+    sym_info = fml_sym_add (fml->sym_tab, "list");
+    sym_info->kind = FML_CPREFIX;
+    sym_info->prefix = fml_exec_list;
 }
diff --git a/fml/fmlmarc.c b/fml/fmlmarc.c
new file mode 100644 (file)
index 0000000..0db5ee3
--- /dev/null
@@ -0,0 +1,126 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlmarc.c,v $
+ * Revision 1.1  1995/02/10 15:50:56  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ */
+
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include <fmlmarc.h>
+#include <iso2709p.h>
+
+#include "fmlp.h"
+
+struct fml_node *marc_to_fml (Fml fml, Iso2709Rec rec)
+{
+    struct fml_node *ptr_0 = NULL, *ptr_1;
+    struct iso2709_dir *dir;
+
+    for (dir = rec->directory; dir; dir=dir->next)
+    {
+        struct fml_node *ptr;
+
+        ptr = fml_node_alloc (fml);
+        if (ptr_0)
+            ptr_1->p[1] = ptr;
+        else
+            ptr_0 = ptr_1 = ptr;
+
+        ptr_1 = ptr;
+
+        if (dir->fields)
+        {
+            struct iso2709_field *fields = dir->fields;
+
+            ptr = fml_node_alloc (fml);
+            ptr->p[0] = fml_atom_alloc (fml, fields->data);
+            ptr->is_atom = 1;
+            
+            while ((fields = fields->next))
+            {
+                ptr = ptr->p[0] = fml_node_alloc (fml);
+                ptr->p[0] = fml_atom_alloc (fml, fields->data);
+                ptr->is_atom = 1;
+            }
+        }
+    }
+    return ptr_0;
+}
+
+
+static void add_string (const char *str, char **buf, int *max, int *size)
+{
+    if (*size + strlen(str) >= *max)
+    {
+        char *nbuf;
+        int nsize = *size + strlen(str) + 2048;
+
+        nbuf = malloc (nsize);
+        assert (nbuf);
+        if (*buf)
+            strcpy (nbuf, *buf);
+        else
+            *nbuf = '\0';
+        free (*buf);
+        *buf = nbuf;
+        *max = nsize;
+    }
+    strcpy (*buf + *size, str);
+    *size += strlen(str);
+}
+
+char *marc_to_str (Fml fml, Iso2709Rec rec)
+{
+    struct iso2709_dir *dir;
+    static char *buf = NULL;
+    static int max = 0;
+    int size = 0;
+
+    add_string ("{", &buf, &max, &size);
+    for (dir = rec->directory; dir; dir=dir->next)
+    {
+        struct iso2709_field *fields;
+
+        add_string ("{", &buf, &max, &size);
+        add_string (dir->tag, &buf, &max, &size);
+        add_string ("{", &buf, &max, &size);
+        
+        for (fields = dir->fields; fields; fields=fields->next)
+        {
+            add_string ("{", &buf, &max, &size);
+            
+            if (fields->indicator)
+            {
+                add_string ("\'", &buf, &max, &size);
+                add_string (fields->indicator, &buf, &max, &size);
+                add_string ("\'", &buf, &max, &size);
+            }
+            else
+                add_string ("{}", &buf, &max, &size);
+            add_string (" ", &buf, &max, &size);
+            if (fields->identifier)
+            {
+                add_string ("\'", &buf, &max, &size);
+                add_string (fields->identifier, &buf, &max, &size);
+                add_string ("\'", &buf, &max, &size);
+            }
+            else
+                add_string ("{}", &buf, &max, &size);
+            add_string (" ", &buf, &max, &size);
+            add_string ("\'", &buf, &max, &size);
+            add_string (fields->data, &buf, &max, &size);
+            add_string ("\'", &buf, &max, &size);
+            add_string ("}", &buf, &max, &size);
+        }
+        add_string ("}}\n", &buf, &max, &size);
+    }
+    add_string ("}", &buf, &max, &size);
+    return buf;
+}
diff --git a/fml/fmlmarc.h b/fml/fmlmarc.h
new file mode 100644 (file)
index 0000000..1d39556
--- /dev/null
@@ -0,0 +1,19 @@
+/*
+ * FML interpreter. Europagate, 1995
+ *
+ * $Log: fmlmarc.h,v $
+ * Revision 1.1  1995/02/10 15:50:56  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ *
+ */
+
+#ifndef FML_MARC_H
+#define FML_MARC_H
+#include <iso2709.h>
+#include <fml.h>
+
+char *marc_to_str (Fml fml, Iso2709Rec rec);
+#endif
index 3c7015e..9a4244e 100644 (file)
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmlp.h,v $
- * Revision 1.6  1995/02/09 16:06:07  adam
+ * Revision 1.7  1995/02/10 15:50:56  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.6  1995/02/09  16:06:07  adam
  * FML can be called from the outside multiple times by the functions:
  * fml_exec_call and fml_exec_call_str.
  * An interactive parameter (-i) to fmltest starts a shell-like
  *
  */
 
-#include "fml.h"
+#include <fml.h>
+
+#ifndef FMLP_H
+#define FMLP_H
 
 #define FML_MAX_TOKEN 2048
 
@@ -119,3 +127,4 @@ void fml_del_token (struct token *tp, Fml fml);
 struct fml_node *fml_expr_term (Fml fml, struct fml_node **lp, 
                                 struct token *tp);
 struct fml_node *fml_exec_group (struct fml_node *list, Fml fml);
+#endif
index 9c944e1..13dda1e 100644 (file)
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmltest.c,v $
- * Revision 1.4  1995/02/09 16:06:08  adam
+ * Revision 1.5  1995/02/10 15:50:56  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.4  1995/02/09  16:06:08  adam
  * FML can be called from the outside multiple times by the functions:
  * fml_exec_call and fml_exec_call_str.
  * An interactive parameter (-i) to fmltest starts a shell-like
@@ -24,7 +29,9 @@
 
 #include <stdio.h>
 #include <string.h>
-#include "fml.h"
+#include <stdlib.h>
+
+#include <fmlmarc.h>
 
 static FILE *inf;
 
@@ -38,6 +45,7 @@ int main (int argc, char **argv)
     Fml fml;
     int nfiles = 0;
     int interactive = 0;
+    Iso2709Rec rec = NULL;
 
     fml = fml_open ();
     while (-- argc > 0)
@@ -50,12 +58,38 @@ int main (int argc, char **argv)
             else if (argv[0][1] == 'm')
                 fml->debug |= 2;
             else if (argv[0][1] == 'i')
-            {
                 interactive = 1;
+            else if (argv[0][1] == '2')
+            {
+                if (argc > 1)
+                {
+                    char *buf;
+                    FILE *inf;
+                    ++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, "uknown option `%s'\n", *argv);
+                fprintf (stderr, "unknown option `%s'\n", *argv);
                 exit (1);
             }
         }
@@ -65,7 +99,7 @@ int main (int argc, char **argv)
             inf = fopen (*argv, "r");
             if (!inf)
             {
-                fprintf (stderr, "cannot open `%s'\n", *argv);
+                fprintf (stderr, "cannot open FML file `%s'\n", *argv);
                 exit (1);
             }
             fml->read_func = inf_read;
@@ -88,6 +122,7 @@ int main (int argc, char **argv)
             while (1)
             {
                 char *cp;
+                const char *nargv[4];
 
                 printf ("\nFML>");
                 fflush (stdout);
@@ -96,7 +131,20 @@ int main (int argc, char **argv)
                     break;
                 if ((cp = strchr (arg, '\n')))
                     *cp = '\0';
-                fml_exec_call_str (fml, arg);
+                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;
+                }
+                fml_exec_call_argv (fml, nargv);
             }
         }
     }
index 77f9139..fc4d189 100644 (file)
@@ -2,7 +2,12 @@
  * FML interpreter. Europagate, 1995
  *
  * $Log: fmltoken.c,v $
- * Revision 1.2  1995/02/07 16:09:24  adam
+ * Revision 1.3  1995/02/10 15:50:57  adam
+ * MARC interface implemented. Minor bugs fixed. fmltest can
+ * be used to format single MARC records. New function '\list'
+ * implemented.
+ *
+ * Revision 1.2  1995/02/07  16:09:24  adam
  * The \ character is no longer INCLUDED when terminating a token.
  * Major changes in tokenization routines. Bug fixes in expressions
  * with lists (fml_sub0).
@@ -86,7 +91,6 @@ struct fml_node *fml_group (Fml fml)
             struct fml_node *sptr = fml_group (fml);
             if (sptr)
             {
-#if 1
                 ptr2 = fml_node_alloc (fml);
                 if (!ptr0)
                     ptr0 = ptr2;
@@ -94,28 +98,6 @@ struct fml_node *fml_group (Fml fml)
                         ptr1->p[1] = ptr2;
                 ptr2->p[0] = sptr;
                 ptr2->is_atom = 0;
-
-#else
-/* make group of one become an element ... */
-                if (sptr->p[1])
-                {
-                    ptr2 = fml_node_alloc (fml);
-                    if (!ptr0)
-                        ptr0 = ptr2;
-                    else
-                        ptr1->p[1] = ptr2;
-                    ptr2->p[0] = sptr;
-                    ptr2->is_atom = 0;
-                }  
-                else
-                {
-                    ptr2 = sptr;
-                    if (!ptr0)
-                        ptr0 = ptr2;
-                    else
-                        ptr1->p[1] = ptr2;
-                }
-#endif
             }
             else
             {
@@ -168,6 +150,20 @@ static void lexer (Fml fml)
         look_type = '}';
         look_char = (*fml->read_func)();
     }        
+    else if (look_char == '\'')
+    {
+        off = 0;
+        look_char = (*fml->read_func)();
+        while (look_char != fml->eof_mark && look_char != '\'')
+        {
+            lex_buf[off++] = look_char;
+            look_char = (*fml->read_func)();
+        } 
+        lex_buf[off] = '\0';
+        look_type = 'a';
+        if (look_char == '\'')
+            look_char = (*fml->read_func)();
+    }
     else
     {
         off = 0;
diff --git a/fml/marc.fml b/fml/marc.fml
new file mode 100644 (file)
index 0000000..bb86797
--- /dev/null
@@ -0,0 +1,27 @@
+# Fml scripts to display MARC records
+# $Id: marc.fml,v 1.1 1995/02/10 15:50:57 adam Exp $
+\func display rec {
+       Record\n 
+       \foreach line {\rec} {
+               \line \index 1 \ 
+               \foreach field {\line \index 2} {
+                       \field \index 1 
+                       \ $\field \index 2 
+                       \field \index 3
+               }
+               \n
+       }
+}
+
+\func f0 rec {
+       \foreach line {\rec} {
+               \line \index 1 \ 
+               \line \index 2 \index 1 \index 1
+               \foreach field {\line \index 2} {
+                       \ $\field \index 2\ 
+                       \field \index 3
+               }
+               \n
+       }
+}
+