Feature: SUTRS. Setting getSutrs implemented.

Work on display formats.
Preferred record syntax can be set by the user.

diff --git a/client.tcl b/client.tcl
index 81901c9..0418f81 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,12 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.51  1995-06-21 11:11:00  adam
+# Revision 1.52  1995-06-22 13:14:59  adam
+# Feature: SUTRS. Setting getSutrs implemented.
+# Work on display formats.
+# Preferred record syntax can be set by the user.
+#
+# Revision 1.51  1995/06/21  11:11:00  adam
 # Bug fix: libdir undefined in about-origin.
 #
 # Revision 1.50  1995/06/21  11:04:48  adam
@@ -199,6 +204,7 @@ set fullMarcSeq 0
 set displayFormat 1
 set popupMarcdf 0
 set textWrap word
+set recordSyntax USMARC
 set delayRequest {}
 
 set queryTypes {Simple}
@@ -216,9 +222,11 @@ proc read-formats {} {
     set formats [glob -nocomplain ${libdir}/formats/*.tcl]
     foreach f $formats {
        if {[file readable $f]} {
-             source $f
-             set l [expr [string length $f] - 5]
-            lappend displayFormats [string range $f 8 $l]
+            source $f
+            set l [string length $f]
+            set f [string range $f [string length "${libdir}/formats/"] \
+                    [expr $l - 5]]
+            lappend displayFormats $f
         }
     }
 }
@@ -231,7 +239,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
-    puts $m
+#    puts $m
 }
 
 proc set-display-format {f} {
@@ -247,7 +255,7 @@ proc set-display-format {f} {
         .bot.a.status configure -text "Reformatting"
     }
     update idletasks
-    add-title-lines 0 10000 1
+    add-title-lines -1 10000 1
     if {!$busy} {
         .bot.a.status configure -text "Ready"
     }
@@ -634,11 +642,6 @@ proc popup-marc {sno no b df} {
     set recordType [z39.$sno recordType $no]
     wm title $w "$recordType record #$no"
 
-    set ffunc [lindex $displayFormats $df]
-    set ffunc "display-$ffunc"
-
-    $ffunc $sno $no $w.top.record 0
-
     if {$new} {
         bind $w.top.record <Return> {destroy .full-marc}
         
@@ -672,6 +675,10 @@ proc popup-marc {sno no b df} {
             incr i
         }
     }
+    set ffunc [lindex $displayFormats $df]
+    set ffunc "display-$ffunc"
+
+    $ffunc $sno $no $w.top.record 0
 }
 
 proc update-target-hotlist {target base} {
@@ -786,7 +793,6 @@ proc open-target {target base} {
         show-status Ready 0 {}
         return
     }
-#    z39 options search present scan namedResultSets triggerResourceCtrl
     set hostid $target
     .top.target.m disable 0
     .top.target.m enable 1
@@ -901,6 +907,7 @@ proc search-request {bflag} {
     global busy
     global cancelFlag
     global delayRequest
+    global recordSyntax
 
     set target $hostid
 
@@ -938,6 +945,9 @@ proc search-request {bflag} {
     if {[lindex $profile($target) 9] == 1} {
         z39.$setNo queryType ccl
     }
+    dputs Setting
+    dputs $recordSyntax
+    z39.$setNo preferredRecordSyntax $recordSyntax
     z39 callback {search-response}
     z39.$setNo search $query
     show-status {Searching} 1 0
@@ -1323,7 +1333,7 @@ proc add-title-lines {setno no offset} {
     global displayFormat
     global lastSetNo
 
-    if {$setno == 0} {
+    if {$setno == -1} {
         set setno $lastSetNo
     } else {
         set lastSetNo $setno
@@ -1333,6 +1343,7 @@ proc add-title-lines {setno no offset} {
         .data.record delete 0.0 end
     }
     set ffunc [lindex $displayFormats $displayFormat]
+    dputs "ffunc=$ffunc"
     set ffunc "display-$ffunc"
     for {set i 0} {$i < $no} {incr i} {
         set o [expr $i + $offset]
@@ -1890,6 +1901,7 @@ proc save-geometry {} {
     global textWrap
     global displayFormat
     global popupMarcdf
+    global recordSyntax
     
     set windowGeometry(.) [wm geometry .]
 
@@ -1899,6 +1911,7 @@ proc save-geometry {} {
     puts $f "set textWrap $textWrap"
     puts $f "set displayFormat $displayFormat"
     puts $f "set popupMarcdf $popupMarcdf"
+    puts $f "set recordSyntax $recordSyntax"
     foreach n [array names windowGeometry] {
         puts -nonewline $f "set \{windowGeometry($n)\} \{"
         puts -nonewline $f $windowGeometry($n)
@@ -1915,7 +1928,7 @@ proc save-settings {} {
     global queryButtons
     global queryInfo
    
-    if {![file writeable "${libdir}/clientrc.tcl"]} {
+    if {![file writable "${libdir}/clientrc.tcl"]} {
        return
     }
     set f [open "${libdir}/clientrc.tcl" w]
@@ -2759,6 +2772,7 @@ menu .top.options.m
 .top.options.m add cascade -label "Query" -menu .top.options.m.query
 .top.options.m add cascade -label "Format" -menu .top.options.m.formats
 .top.options.m add cascade -label "Wrap" -menu .top.options.m.wrap
+.top.options.m add cascade -label "Syntax" -menu .top.options.m.syntax
 
 menu .top.options.m.query
 .top.options.m.query add cascade -label "Select" \
@@ -2791,6 +2805,25 @@ menu .top.options.m.wrap
 .top.options.m.wrap add radiobutton -label "None" \
         -value none -variable textWrap -command {set-wrap none}
 
+menu .top.options.m.syntax
+.top.options.m.syntax add radiobutton -label "USMARC" \
+        -value USMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "UNIMARC" \
+        -value UNIMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "UKMARC" \
+        -value UKMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "DANMARC" \
+        -value DANMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "FINMARC" \
+        -value FINMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "NORMARC" \
+        -value NORMARC -variable recordSyntax
+.top.options.m.syntax add radiobutton -label "PICAMARC" \
+        -value PICAMARC -variable recordSyntax
+.top.options.m.syntax add separator
+.top.options.m.syntax add radiobutton -label "SUTRS" \
+        -value SUTRS -variable recordSyntax
+
 menubutton .top.help -text "Help" -menu .top.help.m
 menu .top.help.m
 

diff --git a/clientrc.tcl b/clientrc.tcl
index 8785e93..012a538 100644 (file)
--- a/clientrc.tcl
+++ b/clientrc.tcl
@@ -2,9 +2,9 @@
 set {profile(Penn)} {{Penn State's Library} 128.118.88.200 210 {} 16384 8192 tcpip CATALOG 1 {} {} Z39 2}
 set {profile(ztest)} {{test server} localhost 9999 {} 16384 4096 tcpip dummy 1 {} {} Z39 3}
 set {profile(madison)} {{University of Wisconsin-Madison} z3950.adp.wisc.edu 210 {} 16384 8192 tcpip madison 1 {} {} Z39 22}
-set {profile(Default)} {{} {} {210} {} 16384 8192 tcpip {} {} {} {} {} 25}
+set {profile(Default)} {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} {} 25}
 set {profile(RLG)} {{Research Libraries group} rlg.stanford.edu 210 {} 4096 4096 tcpip {BKS AMC MAPS MDF REC SCO SER VIM NAF SAF AUT CATALOG ABI AVI DSA EIP FLP HAP HST NPA PAI PRA WLI} 1 {} {} Z39 5}
-set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 16384 8192 tcpip Default {} {} {} Z39 21}
+set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 16384 16384 tcpip Default {} {} {} Z39 21}
 set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 2210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 Z39 6}
 set {profile(DANBIB)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 SR 8}
 set {profile(OCLC)} {{OCLC First search engine} z3950.oclc.org 210 {} 16384 8192 tcpip {ArticleFirst BiographyIndex BusinessPeriodicalsIndex} 1 {} {} Z39 9}

diff --git a/ir-tcl.c b/ir-tcl.c
index d2c1881..30a3b5b 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,12 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.45  1995-06-20 08:07:30  adam
+ * Revision 1.46  1995-06-22 13:15:06  adam
+ * Feature: SUTRS. Setting getSutrs implemented.
+ * Work on display formats.
+ * Preferred record syntax can be set by the user.
+ *
+ * Revision 1.45  1995/06/20  08:07:30  adam
  * New setting: failInfo.
  * Working on better cancel mechanism.
  *
@@ -1557,6 +1562,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         ident.proto = p->protocol_type;
         ident.class = CLASS_RECSYN;
         ident.value = *obj->set_inher.preferredRecordSyntax;
+        logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
         req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
                                                  oid_getoidbyent (&ident));
     }
@@ -1903,6 +1909,41 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
     return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv);
 }
 
+/*
+ * do_getSutrs: Get SUTRS Record
+ */
+static int do_getSutrs (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_SUTRS)
+        return TCL_OK;
+    Tcl_AppendElement (interp, rl->u.dbrec.buf);
+    return TCL_OK;
+}
+
 
 /*
  * do_responseStatus: Return response status (present or search)
@@ -1993,7 +2034,19 @@ static int do_present (void *o, Tcl_Interp *interp,
     
     req->resultSetStartPoint = &start;
     req->numberOfRecordsRequested = &number;
-    req->preferredRecordSyntax = 0;
+    if (obj->set_inher.preferredRecordSyntax)
+    {
+        struct oident ident;
+
+        ident.proto = p->protocol_type;
+        ident.class = CLASS_RECSYN;
+        ident.value = *obj->set_inher.preferredRecordSyntax;
+        logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
+        req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
+                                                 oid_getoidbyent (&ident));
+    }
+    else
+        req->preferredRecordSyntax = 0;
 
     if (!z_APDU (p->odr_out, &apdu, 0))
     {
@@ -2072,6 +2125,7 @@ static IrTcl_Method ir_set_method_tab[] = {
     { 0, "present",                 do_present },
     { 0, "type",                    do_type },
     { 0, "getMarc",                 do_getMarc },
+    { 0, "getSutrs",                do_getSutrs },
     { 0, "recordType",              do_recordType },
     { 0, "diag",                    do_diag },
     { 0, "responseStatus",          do_responseStatus },
@@ -2654,22 +2708,44 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
             {
                 Z_DatabaseRecord *zr; 
                 Odr_external *oe;
+                struct oident *ident;
                 
                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
                     ->u.databaseRecord;
                 oe = (Odr_external*) zr;
                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 (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
                 {
-                    const char *buf = (char*) zr->u.octet_aligned->buf;
+                    char *buf = (char*) zr->u.octet_aligned->buf;
                     if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size)))
                        memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
-                    if (oe->direct_reference)
+                }
+                else if (rl->u.dbrec.type == VAL_SUTRS && 
+                         oe->which == ODR_EXTERNAL_single)
+                {
+                    Odr_oct *rc;
+                    
+                    logf (LOG_DEBUG, "Decoding SUTRS");
+                    odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
+                                oe->u.single_ASN1_type->len, 0);
+                    if (!z_SUTRS(p->odr_in, &rc, 0))
+                    {
+                        logf (LOG_WARN, "Cannot decode SUTRS");
+                        rl->u.dbrec.buf = NULL;
+                    }
+                    else 
                     {
-                        struct oident *ident = 
-                            oid_getentbyoid (oe->direct_reference);
-                        rl->u.dbrec.type = ident->value;
+                        if ((rl->u.dbrec.buf = malloc (rc->len+1)))
+                        {
+                            memcpy (rl->u.dbrec.buf, rc->buf, rc->len);
+                            rl->u.dbrec.buf[rc->len] = '\0';
+                        }
+                        rl->u.dbrec.size = rc->len;
                     }
                 }
                 else

diff --git a/marc.c b/marc.c
index 6322dc6..d3ba72f 100644 (file)
--- a/marc.c
+++ b/marc.c
@@ -5,7 +5,12 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: marc.c,v $
- * Revision 1.3  1995-05-29 08:44:26  adam
+ * 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.
+ *
+ * Revision 1.3  1995/05/29  08:44:26  adam
  * Work on delete of objects.
  *
  * Revision 1.2  1995/05/26  11:44:11  adam
@@ -36,6 +41,8 @@ static int atoi_n (const char *buf, int len)
     {
         if (isdigit (*buf))
             val = val*10 + (*buf - '0');
+        else if (*buf != ' ')
+            return 0;
        buf++;
     }
     return val;
@@ -103,6 +110,11 @@ int ir_tcl_get_marc (Tcl_Interp *interp, const char *buf,
         Tcl_AppendResult (interp, "Unknown MARC extract mode", NULL);
        return TCL_ERROR;
     }
+    if (!buf)
+    {
+        Tcl_AppendResult (interp, "Not a MARC record", NULL);
+        return TCL_ERROR;
+    }
     record_length = atoi_n (buf, 5);
     if (record_length < 25)
     {