From 1b15670e090677122c83f162a446efa5495e6235 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Thu, 22 Jun 1995 13:14:59 +0000 Subject: [PATCH] Feature: SUTRS. Setting getSutrs implemented. Work on display formats. Preferred record syntax can be set by the user. --- client.tcl | 61 ++++++++++++++++++++++++++++++--------- clientrc.tcl | 4 +-- ir-tcl.c | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++----- marc.c | 14 ++++++++- 4 files changed, 145 insertions(+), 24 deletions(-) diff --git a/client.tcl b/client.tcl index 81901c9..0418f81 100644 --- 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 {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 --- 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 --- 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 --- 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) { -- 1.7.10.4