Allow YAZ 2 series only

[ir-tcl-moved-to-github.git] / shell.tcl

diff --git a/shell.tcl b/shell.tcl
index 5a9161a..9b64f68 100644 (file)
--- a/shell.tcl
+++ b/shell.tcl
@@ -1,23 +1,75 @@
-# $Id: shell.tcl,v 1.1 1995-06-30 12:39:27 adam Exp $
+# $Id: shell.tcl,v 1.8 2002-03-21 11:11:53 adam Exp $
 #
+
+if {[catch {ir-log-init all irtcl shell.log}]} {
+    set e [info sharedlibextension]
+    puts "Loading irtcl$e ..."
+    load ./irtcl$e irtcl
+    ir-log-init all irtcl shell.log
+}
+
 source display.tcl
 
-proc target {name database} {
-    ir z
-    z failback {puts "Connection failed"}
+ir z
+
+set pref(base) Default
+set pref(format) usmarc
+
+proc help {} {
+    puts "Commands:"
+    puts " target <host>"
+    puts " base <base>"
+    puts " format <format>"
+    puts " find <query>"
+    puts " sort <attr> <flag>"
+    puts " show <offset> <number>"
+    puts ""
+}
+
+proc fail-response {} {
+    global ok
+    set ok -1
+}
+proc target {name} {
+    global ok pref
+
+    set ok 0
+    z disconnect
+    z failback {fail-response}
     z callback {connect-response}
-    z databaseNames $database
-    z connect $name
+    if [catch "z connect $name"] {
+        fail-response
+    } elseif {$ok == 0} {
+        vwait ok
+    }
+    if {$ok == 1} {
+        puts "Connected and initialized."
+    } else {
+        puts "Failed."
+    }
     return {}
 }
 
+proc base {base} {
+    global pref
+    set pref(base) $base
+}
+
+proc format {format} {
+    global pref
+    set pref(format) $format
+}
+
 proc connect-response {} {
     z callback {init-response}
     z init
 }
 
 proc init-response {} {
-    puts "Connect and initalized. ok"
+    global ok pref
+
+    set ok 1
+    ir-set z.1 z
 }
 
 proc find-response {z} {
@@ -25,27 +77,42 @@ proc find-response {z} {
     if {$sstatus} {
         set h [$z resultCount]
         puts "Search ok. $h hits"
+       set terms [$z searchResult]
+       foreach tc $terms {
+            puts "[lindex $tc 0]: [lindex $tc 1]"
+        }
     } else {
         puts "Search failed"
     }
     common-response $z 1
 }
 
+proc sort-response {z} {
+    global ok
+    set sstatus [$z sortStatus]
+    puts "Sort Status: $sstatus"
+    set ok 1
+}
+
 proc common-response {z from} {
-    set status [lindex [$z responseStatus] 0]
-    switch $status {
+    global ok pref
+
+    set ok 1
+    set status [$z responseStatus]
+    switch [lindex $status 0] {
     NSD { 
             puts -nonewline "NSD"
-            puts -nonewline [lindex [$z responseStatus] 1]
+            puts -nonewline [lindex $status 1]
             puts -nonewline " "
-            puts -nonewline [lindex [$z responseStatus] 2]
+            puts -nonewline [lindex $status 2]
             puts -nonewline ": "
-            puts -nonewline [lindex [$z responseStatus] 3]
+            puts -nonewline [lindex $status 3]
             puts ""
         }
     DBOSD {
             puts "DBOSD"
-            for {set i $from} {$i < [$z nextResultSetPosition]} {incr i} {
+            set to [expr $from + [$z numberOfRecordsReturned]]
+            for {set i $from} {$i < $to} {incr i} {
                 if {[$z type $i] == ""} {
                     break
                 }
@@ -56,15 +123,47 @@ proc common-response {z from} {
     }
 }
 
-proc show {from number} {
+proc show {{from 1} {number 1}} {
+    global ok pref
+
+    set ok 0
     z callback "common-response z.1 $from"
     z.1 present $from $number
+    vwait ok
+    return {}
+}
+
+proc explain {query} {
+    global ok pref
+
+    set ok 0
+    z.1 databaseNames IR-Explain-1
+    z.1 preferredRecordSyntax explain
+    z callback {find-response z.1}
+    z.1 search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $query"
+    vwait ok
+    return {}
 }
     
 proc find {query} {
-    ir-set z.1 z
-    z failback {puts "Connection closed"}
+    global ok pref
+
+    set ok 0
+    z.1 databaseNames $pref(base)
+    z.1 preferredRecordSyntax $pref(format)
     z callback {find-response z.1}
     z.1 search $query
+    vwait ok
+    return {}
+}
+
+proc sort {query flags} {
+    global ok pref
+
+    set ok 0
+    z callback {sort-response z.1}
+    z.1 sort "$query $flags"
+    vwait ok
+    return {}
 }