From b7bac2322e7a6855f60d167509108eff3d21bd65 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Fri, 30 Jun 1995 12:39:16 +0000 Subject: [PATCH] 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. --- display.tcl | 46 +++++++++++++++++++++++++++++++++++++++ ir-tcl.c | 19 ++++++++++------ marc.c | 12 +++++++--- shell.tcl | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ tclmain.c | 12 +++++++--- 5 files changed, 146 insertions(+), 13 deletions(-) create mode 100644 display.tcl create mode 100644 shell.tcl diff --git a/display.tcl b/display.tcl new file mode 100644 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 --- 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 --- 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 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 --- 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); } } -- 1.7.10.4