shell.tcl

   1 # $Id: shell.tcl,v 1.3 1996-08-21 11:24:03 adam Exp $
   2 #
   3 source display.tcl
   4
   5 ir z
   6 set pref(base) Default
   7 set pref(format) usmarc
   8
   9 proc help {} {
  10     puts "Commands:"
  11     puts " target <host>"
  12     puts " base <base>"
  13     puts " format <format>"
  14     puts " find <query>"
  15     puts " show <offset> <number>"
  16     puts ""
  17 }
  18
  19 proc fail-response {} {
  20     global ok
  21     set ok -1
  22 }
  23 proc target {name} {
  24     global ok pref
  25
  26     set ok 0
  27     z disconnect
  28     z failback {fail-response}
  29     z callback {connect-response}
  30     if [catch "z connect $name"] {
  31         fail-response
  32     } else {
  33         vwait ok
  34     }
  35     return {}
  36 }
  37
  38 proc base {base} {
  39     global pref
  40     set pref(base) $base
  41 }
  42
  43 proc format {format} {
  44     global pref
  45     set pref(format) $format
  46 }
  47
  48 proc connect-response {} {
  49     z callback {init-response}
  50     z init
  51 }
  52
  53 proc init-response {} {
  54     global ok pref
  55
  56     set ok 1
  57     puts "Connected and initialized."
  58     ir-set z.1 z
  59 }
  60
  61 proc find-response {z} {
  62     set sstatus [$z searchStatus]
  63     if {$sstatus} {
  64         set h [$z resultCount]
  65         puts "Search ok. $h hits"
  66     } else {
  67         puts "Search failed"
  68     }
  69     common-response $z 1
  70 }
  71
  72 proc common-response {z from} {
  73     global ok pref
  74
  75     set ok 1
  76     set status [$z responseStatus]
  77     switch [lindex $status 0] {
  78     NSD {
  79             puts -nonewline "NSD"
  80             puts -nonewline [lindex $status 1]
  81             puts -nonewline " "
  82             puts -nonewline [lindex $status 2]
  83             puts -nonewline ": "
  84             puts -nonewline [lindex $status 3]
  85             puts ""
  86         }
  87     DBOSD {
  88             puts "DBOSD"
  89             for {set i $from} {$i < [$z nextResultSetPosition]} {incr i} {
  90                 if {[$z type $i] == ""} {
  91                     break
  92                 }
  93                 puts "\# $i"
  94                 display $z $i
  95             }
  96         }
  97     }
  98 }
  99
 100 proc show {from number} {
 101     global ok pref
 102
 103     set ok 0
 104     z callback "common-response z.1 $from"
 105     z.1 present $from $number
 106     vwait ok
 107     return {}
 108 }
 109
 110 proc find {query} {
 111     global ok pref
 112
 113     set ok 0
 114     z.1 databaseNames $pref(base)
 115     z.1 preferredRecordSyntax $pref(format)
 116     z callback {find-response z.1}
 117     z.1 search $query
 118     vwait ok
 119     return {}
 120 }
 121