shell.tcl

   1 # $Id: shell.tcl,v 1.6 1999-03-22 06:51:34 adam Exp $
   2 #
   3
   4 if {[catch {ir-log-init all irtcl shell.log}]} {
   5     set e [info sharedlibextension]
   6     puts "Loading irtcl$e ..."
   7     load ./irtcl$e irtcl
   8     ir-log-init all irtcl shell.log
   9 }
  10
  11 source display.tcl
  12
  13 ir z
  14
  15 set pref(base) Default
  16 set pref(format) usmarc
  17
  18 proc help {} {
  19     puts "Commands:"
  20     puts " target <host>"
  21     puts " base <base>"
  22     puts " format <format>"
  23     puts " find <query>"
  24     puts " sort <attr> <flag>"
  25     puts " show <offset> <number>"
  26     puts ""
  27 }
  28
  29 proc fail-response {} {
  30     global ok
  31     set ok -1
  32 }
  33 proc target {name} {
  34     global ok pref
  35
  36     set ok 0
  37     z disconnect
  38     z failback {fail-response}
  39     z callback {connect-response}
  40     if [catch "z connect $name"] {
  41         fail-response
  42     } elseif {$ok == 0} {
  43         vwait ok
  44     }
  45     if {$ok == 1} {
  46         puts "Connected and initialized."
  47     } else {
  48         puts "Failed."
  49     }
  50     return {}
  51 }
  52
  53 proc base {base} {
  54     global pref
  55     set pref(base) $base
  56 }
  57
  58 proc format {format} {
  59     global pref
  60     set pref(format) $format
  61 }
  62
  63 proc connect-response {} {
  64     z callback {init-response}
  65     z init
  66 }
  67
  68 proc init-response {} {
  69     global ok pref
  70
  71     set ok 1
  72     ir-set z.1 z
  73 }
  74
  75 proc find-response {z} {
  76     set sstatus [$z searchStatus]
  77     if {$sstatus} {
  78         set h [$z resultCount]
  79         puts "Search ok. $h hits"
  80     } else {
  81         puts "Search failed"
  82     }
  83     common-response $z 1
  84 }
  85
  86 proc sort-response {z} {
  87     global ok
  88     set sstatus [$z sortStatus]
  89     puts "Sort Status: $sstatus"
  90     set ok 1
  91 }
  92
  93 proc common-response {z from} {
  94     global ok pref
  95
  96     set ok 1
  97     set status [$z responseStatus]
  98     switch [lindex $status 0] {
  99     NSD {
 100             puts -nonewline "NSD"
 101             puts -nonewline [lindex $status 1]
 102             puts -nonewline " "
 103             puts -nonewline [lindex $status 2]
 104             puts -nonewline ": "
 105             puts -nonewline [lindex $status 3]
 106             puts ""
 107         }
 108     DBOSD {
 109             puts "DBOSD"
 110             set to [expr $from + [$z numberOfRecordsReturned]]
 111             for {set i $from} {$i < $to} {incr i} {
 112                 if {[$z type $i] == ""} {
 113                     break
 114                 }
 115                 puts "\# $i"
 116                 display $z $i
 117             }
 118         }
 119     }
 120 }
 121
 122 proc show {{from 1} {number 1}} {
 123     global ok pref
 124
 125     set ok 0
 126     z callback "common-response z.1 $from"
 127     z.1 present $from $number
 128     vwait ok
 129     return {}
 130 }
 131
 132 proc explain {query} {
 133     global ok pref
 134
 135     set ok 0
 136     z.1 databaseNames IR-Explain-1
 137     z.1 preferredRecordSyntax explain
 138     z callback {find-response z.1}
 139     z.1 search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $query"
 140     vwait ok
 141     return {}
 142 }
 143
 144 proc find {query} {
 145     global ok pref
 146
 147     set ok 0
 148     z.1 databaseNames $pref(base)
 149     z.1 preferredRecordSyntax $pref(format)
 150     z callback {find-response z.1}
 151     z.1 search $query
 152     vwait ok
 153     return {}
 154 }
 155
 156 proc sort {query flags} {
 157     global ok pref
 158
 159     set ok 0
 160     z callback {sort-response z.1}
 161     z.1 sort "$query $flags"
 162     vwait ok
 163     return {}
 164 }
 165