Work on GRS records.

diff --git a/Makefile.in b/Makefile.in
index 5a66b25..b98be9d 100644 (file)
--- a/Makefile.in
+++ b/Makefile.in
@@ -2,7 +2,7 @@
 # (c) Index Data 1995
 # See the file LICENSE for details.
 # Sebastian Hammer, Adam Dickmeiss
-# $Id: Makefile.in,v 1.15 1995-08-04 11:32:36 adam Exp $
+# $Id: Makefile.in,v 1.16 1995-08-29 15:30:12 adam Exp $
 SHELL=/bin/sh
 
 # IrTcl Version
@@ -52,7 +52,7 @@ INSTALL_PROGRAM = @INSTALL_PROGRAM@
 INSTALL_DATA = @INSTALL_DATA@
 RANLIB = @RANLIB@
 
-O=ir-tcl.o marc.o queue.o mem.o
+O=ir-tcl.o marc.o queue.o mem.o grs.o
 
 all: ir-tk ir-tcl
 

diff --git a/client.tcl b/client.tcl
index baad580..7ef4fde 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,10 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.65  1995-08-24 15:39:09  adam
+# Revision 1.66  1995-08-29 15:30:13  adam
+# Work on GRS records.
+#
+# Revision 1.65  1995/08/24  15:39:09  adam
 # Minor changes.
 #
 # Revision 1.64  1995/08/24  15:33:02  adam
@@ -331,7 +334,9 @@ proc tkerror err {
 proc read-formats {} {
     global displayFormats
     global libdir
-    set formats [glob -nocomplain ${libdir}/formats/*.tcl]
+    if {[catch {set formats [glob -nocomplain ${libdir}/formats/*.tcl]}]} {
+        set formats ./formats/raw.tcl
+    }
     foreach f $formats {
        if {[file readable $f]} {
             source $f
@@ -3035,6 +3040,9 @@ menu .top.options.m.syntax
 .top.options.m.syntax add separator
 .top.options.m.syntax add radiobutton -label "SUTRS" \
         -value SUTRS -variable recordSyntax
+.top.options.m.syntax add separator
+.top.options.m.syntax add radiobutton -label "GRS1" \
+        -value GRS1 -variable recordSyntax
 
 menubutton .top.help -text "Help" -menu .top.help.m
 menu .top.help.m

diff --git a/ir-tcl.c b/ir-tcl.c
index 86da3b3..36d46f4 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.55  1995-08-28 09:43:25  adam
+ * Revision 1.56  1995-08-29 15:30:14  adam
+ * Work on GRS records.
+ *
+ * Revision 1.55  1995/08/28  09:43:25  adam
  * Minor changes. configure only searches for yaz beta 3 and versions after
  * that.
  *
@@ -272,6 +275,7 @@ static struct {
 { VAL_AUSMARC,    "AUSMARC" },
 { VAL_IBERMARC,   "IBERMARC" },
 { VAL_SUTRS,      "SUTRS" },
+{ VAL_GRS1,       "GRS1" },
 { 0, NULL }
 };
 
@@ -1929,6 +1933,41 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 
 
 /*
+ * do_getGrs: Get a GRS1 Record
+ */
+static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    int offset;
+    IrTcl_RecordList *rl;
+
+    if (argc <= 0)
+        return TCL_OK;
+    if (argc < 3)
+    {
+        sprintf (interp->result, "wrong # args");
+        return TCL_ERROR;
+    }
+    if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
+        return TCL_ERROR;
+    rl = find_IR_record (obj, offset);
+    if (!rl)
+    {
+        Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->which != Z_NamePlusRecord_databaseRecord)
+    {
+        Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->u.dbrec.type != VAL_GRS1)
+        return TCL_OK;
+    return ir_tcl_get_grs (interp, rl->u.dbrec.u.grs1, argc, argv);
+}
+
+
+/*
  * do_responseStatus: Return response status (present or search)
  */
 static int do_responseStatus (void *o, Tcl_Interp *interp, 
@@ -2086,6 +2125,7 @@ static IrTcl_Method ir_set_method_tab[] = {
     { 0, "type",                    do_type },
     { 0, "getMarc",                 do_getMarc },
     { 0, "getSutrs",                do_getSutrs },
+    { 0, "getGrs",                  do_getGrs },
     { 0, "recordType",              do_recordType },
     { 0, "diag",                    do_diag },
     { 0, "responseStatus",          do_responseStatus },
@@ -2644,9 +2684,11 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj)
                 oe = (Z_External*) zr;
                rl->u.dbrec.size = zr->u.octet_aligned->len;
 
-                rl->u.dbrec.type = VAL_USMARC;
                 if ((ident = oid_getentbyoid (oe->direct_reference)))
                     rl->u.dbrec.type = ident->value;
+                else
+                    rl->u.dbrec.type = VAL_USMARC;
+
                 if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
                 {
                     char *buf = (char*) zr->u.octet_aligned->buf;
@@ -2666,6 +2708,12 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj)
                     }
                     rl->u.dbrec.size = oe->u.sutrs->len;
                 }
+                else if (rl->u.dbrec.type == VAL_GRS1 && 
+                         oe->which == Z_External_grs1)
+                {
+                    ir_tcl_read_grs (oe->u.grs1, &rl->u.dbrec.u.grs1);
+                    rl->u.dbrec.buf = NULL;
+                }
                 else
                     rl->u.dbrec.buf = NULL;
             }

diff --git a/ir-tclp.h b/ir-tclp.h
index ebf7cb2..8a78675 100644 (file)
--- a/ir-tclp.h
+++ b/ir-tclp.h
@@ -5,7 +5,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tclp.h,v $
- * Revision 1.14  1995-08-04 11:32:40  adam
+ * Revision 1.15  1995-08-29 15:30:15  adam
+ * Work on GRS records.
+ *
+ * Revision 1.14  1995/08/04  11:32:40  adam
  * More work on output queue. Memory related routines moved
  * to mem.c
  *
@@ -163,6 +166,25 @@ typedef struct {
     char *addinfo;
 } IrTcl_Diagnostic;
 
+struct GRS_Record_entry {
+    int tagType;
+    int tagWhich;
+    union {
+        int num;
+        char *str;
+    } tagVal;
+    int dataWhich;
+    union {
+        struct IrTcl_GRS_Record_ *sub;
+        char *str;
+    } tagData;
+};
+
+typedef struct IrTcl_GRS_Record_ {
+    int noTags;
+    struct GRS_Record_entry *entries;
+} IrTcl_GRS_Record;
+
 typedef struct IrTcl_RecordList_ {
     int no;
     int which;
@@ -170,6 +192,9 @@ typedef struct IrTcl_RecordList_ {
         struct {
            char *buf;
            size_t size;
+            union {
+                IrTcl_GRS_Record *grs1;
+            } u;
             enum oid_value type;
         } dbrec;
         struct {
@@ -249,6 +274,9 @@ int ir_tcl_strdup (Tcl_Interp *interp, char** p, const char *s);
 int ir_tcl_strdel (Tcl_Interp *interp, char **p);
 
 char *ir_tcl_fread_marc (FILE *inf, size_t *size);
+void ir_tcl_read_grs (Z_GenericRecord *r, IrTcl_GRS_Record **grs_record);
+int ir_tcl_get_grs (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record, 
+                     int argc, char **argv);
 
 #define IR_TCL_FAIL_CONNECT      1
 #define IR_TCL_FAIL_READ         2

diff --git a/mem.c b/mem.c
index 90ab67c..12ece38 100644 (file)
--- a/mem.c
+++ b/mem.c
@@ -5,7 +5,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: mem.c,v $
- * Revision 1.1  1995-08-04 11:32:40  adam
+ * Revision 1.2  1995-08-29 15:30:15  adam
+ * Work on GRS records.
+ *
+ * Revision 1.1  1995/08/04  11:32:40  adam
  * More work on output queue. Memory related routines moved
  * to mem.c
  *
@@ -37,14 +40,22 @@ void *ir_tcl_malloc (size_t n)
  */
 int ir_tcl_strdup (Tcl_Interp *interp, char** p, const char *s)
 {
+    size_t len;
+
     if (!s)
     {
         *p = NULL;
         return TCL_OK;
     }
-    *p = malloc (strlen(s)+1);
+    len = strlen(s)+1;
+    *p = malloc (len);
     if (!*p)
     {
+        if (!interp) 
+        {
+            logf (LOG_FATAL, "Out of memory in strdup. %ld bytes", len);
+            exit (1);
+        }
         interp->result = "strdup fail";
         return TCL_ERROR;
     }