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.
New interactive script: shell.tcl.

diff --git a/display.tcl b/display.tcl
new file mode 100644 (file)
index 0000000..ac03832
--- /dev/null
+++ b/display.tcl
@@ -0,0 +1,46 @@
+# $Id: display.tcl,v 1.1 1995-06-30 12:39:16 adam Exp $
+#
+# Record display
+proc display {zset no} {
+    set type [$zset type $no]
+    if {$type == "SD"} {
+        set err [lindex [$zset diag $no] 1]
+        set add [lindex [$zset diag $no] 2]
+        if {$add != {}} {
+            set add " :${add}"
+        }
+        puts "Error ${err}${add}"
+        return
+    }
+    if {$type != "DB"} {
+        return
+    }
+    set rtype [$zset recordType $no]
+    if {$rtype == "SUTRS"} {
+        puts [join [$zset getSutrs $no]]
+        return
+    } 
+    if {[catch {set r [$zset getMarc $no list * * *]}]} {
+        puts "Unknown record type: $rtype"
+        return
+    }
+    foreach line $r {
+        set tag [lindex $line 0]
+        set indicator [lindex $line 1]
+        set fields [lindex $line 2]
+        puts -nonewline "$tag "
+        if {$indicator != ""} {
+            puts -nonewline $indicator
+        }
+        foreach field $fields {
+            set id [lindex $field 0]
+            set data [lindex $field 1]
+            if {$id != ""} {
+                puts -nonewline " \$$id "
+            }
+            puts -nonewline $data
+        }
+        puts ""
+    }
+}
+

diff --git a/ir-tcl.c b/ir-tcl.c
index b28028d..37386ae 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,13 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.48  1995-06-27 19:03:50  adam
+ * Revision 1.49  1995-06-30 12:39:21  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.
+ * New interactive script: shell.tcl.
+ *
+ * Revision 1.48  1995/06/27  19:03:50  adam
  * Bug fix in do_present in ir-tcl.c: p->set_child member weren't set.
  * nextResultSetPosition used instead of setOffset.
  *
@@ -367,7 +373,8 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
 
     if (argc <= 0)
         return TCL_OK;
-    Tcl_AppendResult (interp, "Bad method. Possible methods:", NULL);
+    Tcl_AppendResult (interp, "Bad method: ", argv[1], 
+                      ". Possible methods:", NULL);
     for (tab_i = tab; tab_i->tab; tab_i++)
         for (t = tab_i->tab; t->name; t++)
             Tcl_AppendResult (interp, " ", t->name, NULL);
@@ -993,8 +1000,6 @@ static int do_connect (void *obj, Tcl_Interp *interp,
                 IrTcl_eval (p->interp, p->callback);
         }
     }
-    if (p->hostname)
-        Tcl_AppendElement (interp, p->hostname);
     return TCL_OK;
 }
 
@@ -2168,6 +2173,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp,
         IrTcl_RecordList *rl;
 
         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord);
+        rl->u.dbrec.type = VAL_USMARC;
         rl->u.dbrec.buf = buf;
        rl->u.dbrec.size = size;
         no++;
@@ -2779,9 +2785,8 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
                rl->u.dbrec.size = zr->u.octet_aligned->len;
 
                 rl->u.dbrec.type = VAL_USMARC;
-                ident = oid_getentbyoid (oe->direct_reference);
-                rl->u.dbrec.type = ident->value;
-
+                if ((ident = oid_getentbyoid (oe->direct_reference)))
+                    rl->u.dbrec.type = ident->value;
                 if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
                 {
                     char *buf = (char*) zr->u.octet_aligned->buf;

diff --git a/marc.c b/marc.c
index d3ba72f..9320d40 100644 (file)
--- a/marc.c
+++ b/marc.c
@@ -5,7 +5,13 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: marc.c,v $
- * Revision 1.4  1995-06-22 13:15:09  adam
+ * 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.
+ * New interactive script: shell.tcl.
+ *
+ * Revision 1.4  1995/06/22  13:15:09  adam
  * Feature: SUTRS. Setting getSutrs implemented.
  * Work on display formats.
  * Preferred record syntax can be set by the user.
@@ -37,12 +43,12 @@ static int atoi_n (const char *buf, int len)
 {
     int val = 0;
 
+    if (!isdigit (buf[len-1]))
+        return 0;
     while (--len >= 0)
     {
         if (isdigit (*buf))
             val = val*10 + (*buf - '0');
-        else if (*buf != ' ')
-            return 0;
        buf++;
     }
     return val;

diff --git a/shell.tcl b/shell.tcl
new file mode 100644 (file)
index 0000000..5a9161a
--- /dev/null
+++ b/shell.tcl
@@ -0,0 +1,70 @@
+# $Id: shell.tcl,v 1.1 1995-06-30 12:39:27 adam Exp $
+#
+source display.tcl
+
+proc target {name database} {
+    ir z
+    z failback {puts "Connection failed"}
+    z callback {connect-response}
+    z databaseNames $database
+    z connect $name
+    return {}
+}
+
+proc connect-response {} {
+    z callback {init-response}
+    z init
+}
+
+proc init-response {} {
+    puts "Connect and initalized. ok"
+}
+
+proc find-response {z} {
+    set sstatus [$z searchStatus]
+    if {$sstatus} {
+        set h [$z resultCount]
+        puts "Search ok. $h hits"
+    } else {
+        puts "Search failed"
+    }
+    common-response $z 1
+}
+
+proc common-response {z from} {
+    set status [lindex [$z responseStatus] 0]
+    switch $status {
+    NSD { 
+            puts -nonewline "NSD"
+            puts -nonewline [lindex [$z responseStatus] 1]
+            puts -nonewline " "
+            puts -nonewline [lindex [$z responseStatus] 2]
+            puts -nonewline ": "
+            puts -nonewline [lindex [$z responseStatus] 3]
+            puts ""
+        }
+    DBOSD {
+            puts "DBOSD"
+            for {set i $from} {$i < [$z nextResultSetPosition]} {incr i} {
+                if {[$z type $i] == ""} {
+                    break
+                }
+                puts "\# $i"
+               display $z $i
+            }
+        }
+    }
+}
+
+proc show {from number} {
+    z callback "common-response z.1 $from"
+    z.1 present $from $number
+}
+    
+proc find {query} {
+    ir-set z.1 z
+    z failback {puts "Connection closed"}
+    z callback {find-response z.1}
+    z.1 search $query
+}
+

diff --git a/tclmain.c b/tclmain.c
index 4277b1a..214ce9a 100644 (file)
--- a/tclmain.c
+++ b/tclmain.c
@@ -5,7 +5,13 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: tclmain.c,v $
- * Revision 1.9  1995-06-26 10:20:20  adam
+ * Revision 1.10  1995-06-30 12:39:28  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.
+ * New interactive script: shell.tcl.
+ *
+ * Revision 1.9  1995/06/26  10:20:20  adam
  * ir-tk works like wish.
  *
  * Revision 1.8  1995/06/21  15:16:44  adam
@@ -207,8 +213,8 @@ void tcl_mainloop (Tcl_Interp *interp, int interactive)
                 Tcl_DStringFree (&command);
                 if (code)
                     printf ("Error: %s\n", interp->result);
-                else
-                    printf ("%s", interp->result);
+                else if (*interp->result)
+                    printf ("%s\n", interp->result);
                 printf ("%% "); fflush (stdout);
             }
         }