shell.tcl

   1 # $Id: shell.tcl,v 1.7 2002-03-20 14:48:54 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         puts [$z searchResult]
  81     } else {
  82         puts "Search failed"
  83     }
  84     common-response $z 1
  85 }
  86
  87 proc sort-response {z} {
  88     global ok
  89     set sstatus [$z sortStatus]
  90     puts "Sort Status: $sstatus"
  91     set ok 1
  92 }
  93
  94 proc common-response {z from} {
  95     global ok pref
  96
  97     set ok 1
  98     set status [$z responseStatus]
  99     switch [lindex $status 0] {
 100     NSD {
 101             puts -nonewline "NSD"
 102             puts -nonewline [lindex $status 1]
 103             puts -nonewline " "
 104             puts -nonewline [lindex $status 2]
 105             puts -nonewline ": "
 106             puts -nonewline [lindex $status 3]
 107             puts ""
 108         }
 109     DBOSD {
 110             puts "DBOSD"
 111             set to [expr $from + [$z numberOfRecordsReturned]]
 112             for {set i $from} {$i < $to} {incr i} {
 113                 if {[$z type $i] == ""} {
 114                     break
 115                 }
 116                 puts "\# $i"
 117                 display $z $i
 118             }
 119         }
 120     }
 121 }
 122
 123 proc show {{from 1} {number 1}} {
 124     global ok pref
 125
 126     set ok 0
 127     z callback "common-response z.1 $from"
 128     z.1 present $from $number
 129     vwait ok
 130     return {}
 131 }
 132
 133 proc explain {query} {
 134     global ok pref
 135
 136     set ok 0
 137     z.1 databaseNames IR-Explain-1
 138     z.1 preferredRecordSyntax explain
 139     z callback {find-response z.1}
 140     z.1 search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $query"
 141     vwait ok
 142     return {}
 143 }
 144
 145 proc find {query} {
 146     global ok pref
 147
 148     set ok 0
 149     z.1 databaseNames $pref(base)
 150     z.1 preferredRecordSyntax $pref(format)
 151     z callback {find-response z.1}
 152     z.1 search $query
 153     vwait ok
 154     return {}
 155 }
 156
 157 proc sort {query flags} {
 158     global ok pref
 159
 160     set ok 0
 161     z callback {sort-response z.1}
 162     z.1 sort "$query $flags"
 163     vwait ok
 164     return {}
 165 }
 166