From 35b50f2f119e882cd67f977bc02b7e9d15830c80 Mon Sep 17 00:00:00 2001
From: Adam Dickmeiss <adam@indexdata.dk>
Date: Wed, 19 Nov 1997 11:22:09 +0000
Subject: [PATCH] Object identifiers can be accessed in GRS-1 records.

---
 formats/line.tcl   |   26 +++++++++++++++++---------
 formats/medium.tcl |   31 +++++++++++++++++--------------
 formats/raw.tcl    |    7 +++++--
 grs.c              |   27 +++++++++++++++++++++++++--
 ir-tcl.c           |   31 +++++++++++++++++++++++--------
 ir-tclp.h          |    6 +++++-
 6 files changed, 92 insertions(+), 36 deletions(-)

diff --git a/formats/line.tcl b/formats/line.tcl
index 9c4b553..b1099bd 100644
--- a/formats/line.tcl
+++ b/formats/line.tcl
@@ -4,7 +4,10 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: line.tcl,v $
-# Revision 1.13  1996-04-12 12:25:27  adam
+# Revision 1.14  1997-11-19 11:22:10  adam
+# Object identifiers can be accessed in GRS-1 records.
+#
+# Revision 1.13  1996/04/12 12:25:27  adam
 # Modified display of GRS-1 records to include headings for standard
 # tag sets.
 #
@@ -62,16 +65,21 @@ proc display-grs-line {w r i} {
         }
         set ttype [lindex $e 0]
         set tval [lindex $e 2]
-        if {[info exists tagSet($ttype,$tval)]} {
-            insertWithTags $w "$tagSet($ttype,$tval) " marc-pref
-        } else {
-            insertWithTags $w "$tval " marc-pref
-        }
-        if {[lindex $e 3] == "string"} {
-            insertWithTags $w [lindex $e 4] marc-text
+	if {$ttype == 2 && $tval == 1} {
+	    if {[lindex $e 3] == "subtree"} {
+		set f [lindex $e 4]
+		foreach e $f {
+		    if {[lindex $e 0] == 1 && [lindex $e 2] == 19} {
+			break
+		    }
+		}
+	    }
+	    if {[lindex $e 3] == "string"} {
+		insertWithTags $w [lindex $e 4] marc-text
+	    }
             insertWithTags $w "\n"
             break
-        }
+	}
     }
     if {[tk4]} {
         $w tag configure indent$i \
diff --git a/formats/medium.tcl b/formats/medium.tcl
index 5f3aa33..cc22d03 100644
--- a/formats/medium.tcl
+++ b/formats/medium.tcl
@@ -4,7 +4,10 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: medium.tcl,v $
-# Revision 1.14  1996-04-12 13:45:49  adam
+# Revision 1.15  1997-11-19 11:22:10  adam
+# Object identifiers can be accessed in GRS-1 records.
+#
+# Revision 1.14  1996/04/12 13:45:49  adam
 # Minor changes.
 #
 # Revision 1.13  1996/04/12  12:25:27  adam
@@ -75,7 +78,7 @@ proc display-grs-medium {w r i} {
             insertWithTags $w "\n"
         } else {
             insertWithTags $w [lindex $e 4] {}
-            insertWithTags $w " ?\n" {}
+            insertWithTags $w " \n" {}
         }
         if {[tk4]} {
             $w tag configure indent$i \
@@ -130,7 +133,7 @@ proc display-medium {sno no w hflag} {
         insertWithTags $w "Unknown record type: $rtype\n" marc-id
         return
     }
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "Title " marc-pref
         insertWithTags $w [string trimright [lindex $i 0] /] marc-text
         set i [z39.$sno getMarc $no field 245 * b]
@@ -140,10 +143,10 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 700 * a]
-    if {"x$i" == "x"} {
+    if {![llength $i]} {
         set i [z39.$sno getMarc $no field 100 * a]
     }
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         if {[llength $i] > 1} {
             insertWithTags $w "Authors " marc-pref
         } else {
@@ -155,7 +158,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 110 * *]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "Co-Author " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -164,7 +167,7 @@ proc display-medium {sno no w hflag} {
     }
 
     set i [z39.$sno getMarc $no field 650 * *]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         set n 0
         insertWithTags $w "Keywords " marc-pref
         foreach x $i {
@@ -178,7 +181,7 @@ proc display-medium {sno no w hflag} {
     }
     set i [concat [z39.$sno getMarc $no field 260 * a] \
             [z39.$sno getMarc $no field 260 * b]]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "Publisher " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -186,7 +189,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 020 * a]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "ISBN " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -194,7 +197,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 022 * a]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "ISSN " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -202,7 +205,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 030 * a]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "CODEN " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -210,7 +213,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 015 * a]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "Ctl number " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -218,7 +221,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 010 * a]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "LC number " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
@@ -226,7 +229,7 @@ proc display-medium {sno no w hflag} {
         $w insert end "\n"
     }
     set i [z39.$sno getMarc $no field 710 * a]
-    if {"x$i" != "x"} {
+    if {[llength $i]} {
         insertWithTags $w "Corporate name " marc-pref
         foreach x $i {
             insertWithTags $w $x marc-text
diff --git a/formats/raw.tcl b/formats/raw.tcl
index cf688e6..91656d5 100644
--- a/formats/raw.tcl
+++ b/formats/raw.tcl
@@ -4,7 +4,10 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: raw.tcl,v $
-# Revision 1.12  1996-04-12 13:45:50  adam
+# Revision 1.13  1997-11-19 11:22:10  adam
+# Object identifiers can be accessed in GRS-1 records.
+#
+# Revision 1.12  1996/04/12 13:45:50  adam
 # Minor changes.
 #
 # Revision 1.11  1996/03/29  16:05:37  adam
@@ -54,7 +57,7 @@ proc display-grs-raw {w r i} {
             display-grs-raw $w [lindex $e 4] [expr $i+1]
         } else {
             insertWithTags $w [lindex $e 4] {}
-            insertWithTags $w " ?\n" {}
+            insertWithTags $w "\n" {}
         }
     }
 }
diff --git a/grs.c b/grs.c
index 6c05faa..2adc2e0 100644
--- a/grs.c
+++ b/grs.c
@@ -5,7 +5,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: grs.c,v $
- * Revision 1.10  1997-09-09 10:19:52  adam
+ * Revision 1.11  1997-11-19 11:22:09  adam
+ * Object identifiers can be accessed in GRS-1 records.
+ *
+ * Revision 1.10  1997/09/09 10:19:52  adam
  * New MSV5.0 port with fewer warnings.
  *
  * Revision 1.9  1996/08/16 15:07:44  adam
@@ -87,6 +90,8 @@ void ir_tcl_grs_del (IrTcl_GRS_Record **grs_record)
             break;
         case Z_ElementData_trueOrFalse:
         case Z_ElementData_oid:
+	    xfree (e->tagData.oid);
+	    break;
         case Z_ElementData_intUnit:
         case Z_ElementData_elementNotThere:
         case Z_ElementData_elementEmpty:
@@ -122,6 +127,7 @@ void ir_tcl_grs_mk (Z_GenericRecord *r, IrTcl_GRS_Record **grs_record)
     for (i = 0; i < r->num_elements; i++, e++)
     {
         Z_TaggedElement *t;
+	int len;
 
         t = r->elements[i];
         if (t->tagType)
@@ -158,6 +164,10 @@ void ir_tcl_grs_mk (Z_GenericRecord *r, IrTcl_GRS_Record **grs_record)
             e->tagData.bool = *t->content->u.trueOrFalse;
             break;
         case Z_ElementData_oid:
+	    len = 1+oid_oidlen (t->content->u.oid);
+	    e->tagData.oid = ir_tcl_malloc (len * sizeof(*e->tagData.oid));
+	    memcpy (e->tagData.oid, t->content->u.oid,
+		    len * sizeof(*e->tagData.oid));
             break;
         case Z_ElementData_intUnit:
             break;
@@ -258,7 +268,20 @@ static int ir_tcl_get_grs_r (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record,
                               e->tagData.bool ? "1" : "0", " ", NULL);
             break;
         case Z_ElementData_oid:
-            Tcl_AppendResult (interp, " oid {} ", NULL);
+            Tcl_AppendResult (interp, " oid", NULL);
+	    if (!e->tagData.oid)
+		Tcl_AppendResult (interp, "{}", NULL);
+	    else
+	    {
+		int i;
+		int sep = ' ';
+		for (i = 0; e->tagData.oid[i] >= 0; i++)
+		{
+		    sprintf (tmpbuf, "%c%d", sep, e->tagData.oid[i]);
+		    Tcl_AppendResult (interp, tmpbuf, NULL);
+		    sep = '.';
+		}
+	    }
             break;
         case Z_ElementData_intUnit:
             Tcl_AppendResult (interp, " intUnit {} ", NULL);
diff --git a/ir-tcl.c b/ir-tcl.c
index 345aec5..1048cf0 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.102  1997-09-17 12:22:40  adam
+ * Revision 1.103  1997-11-19 11:22:10  adam
+ * Object identifiers can be accessed in GRS-1 records.
+ *
+ * Revision 1.102  1997/09/17 12:22:40  adam
  * Changed to use YAZ version 1.4. The new comstack utility, cs_straddr,
  * is used.
  *
@@ -504,8 +507,9 @@ int ir_tcl_eval (Tcl_Interp *interp, const char *command)
     r = Tcl_Eval (interp, tmp);
     if (r == TCL_ERROR)
     {
-        logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, 
-              interp->result);
+	const char *errorInfo = Tcl_GetVar (interp, "errorInfo", 0);
+        logf (LOG_WARN, "Tcl error in line %d: %s\n%s", interp->errorLine, 
+              interp->result, errorInfo ? errorInfo : "<null>");
     }
     Tcl_FreeResult (interp);
     xfree (tmp);
@@ -3469,7 +3473,7 @@ static int ir_log_proc (ClientData clientData, Tcl_Interp *interp,
         return TCL_OK;
     }
     mask = log_mask_str_x (argv[1], 0);
-    logf (mask, "%s", argv[1], mask, argv[2]);
+    logf (LOG_DEBUG, "%s", argv[2]);
     return TCL_OK;
 }
 
@@ -3657,10 +3661,12 @@ static void ir_handleZRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
                     &setobj->nonSurrogateDiagnosticNum);
     if (zrs->which == Z_Records_DBOSD)
     {
-        setobj->numberOfRecordsReturned = 
-            zrs->u.databaseOrSurDiagnostics->num_records;
-        logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
-        for (offset = 0; offset < setobj->numberOfRecordsReturned; offset++)
+	int num_rec = setobj->numberOfRecordsReturned;
+
+	if (num_rec > zrs->u.databaseOrSurDiagnostics->num_records)
+	    num_rec = zrs->u.databaseOrSurDiagnostics->num_records;
+        logf (LOG_DEBUG, "Got %d records", num_rec);
+        for (offset = 0; offset < num_rec; offset++)
         {
             Z_NamePlusRecord *znpr = zrs->u.databaseOrSurDiagnostics->
                 records[offset];
@@ -3726,10 +3732,14 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
             es = setobj->set_inher.smallSetElementSetNames;
         else 
             es = setobj->set_inher.mediumSetElementSetNames;
+	setobj->numberOfRecordsReturned = *searchrs->numberOfRecordsReturned;
         ir_handleZRecords (o, zrs, setobj, es);
     }
     else
+    {
+	setobj->numberOfRecordsReturned = 0;
         setobj->recordFlag = 0;
+    }
 }
 
 
@@ -3748,9 +3758,13 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs,
     get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId);
     setobj->nextResultSetPosition = *presrs->nextResultSetPosition;
     if (zrs)
+    {
+	setobj->numberOfRecordsReturned = *presrs->numberOfRecordsReturned;
         ir_handleZRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
+    }
     else
     {
+	setobj->numberOfRecordsReturned = 0;
         setobj->recordFlag = 0;
         logf (LOG_DEBUG, "No records!");
     }
@@ -4137,6 +4151,7 @@ EXPORT (int,Irtcl_Init) (Tcl_Interp *interp)
                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand (interp, "ir-log", ir_log_proc,
                        (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    nmem_init ();
     return TCL_OK;
 }
 
diff --git a/ir-tclp.h b/ir-tclp.h
index 1712e51..33f8462 100644
--- a/ir-tclp.h
+++ b/ir-tclp.h
@@ -5,7 +5,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tclp.h,v $
- * Revision 1.35  1997-09-09 10:19:54  adam
+ * Revision 1.36  1997-11-19 11:22:09  adam
+ * Object identifiers can be accessed in GRS-1 records.
+ *
+ * Revision 1.35  1997/09/09 10:19:54  adam
  * New MSV5.0 port with fewer warnings.
  *
  * Revision 1.34  1996/08/16 15:07:47  adam
@@ -280,6 +283,7 @@ struct GRS_Record_entry {
         } octets;
         int num;
         int bool;
+	Odr_oid *oid;
     } tagData;
 };
 
-- 
1.7.10.4