projects
/
ir-tcl-moved-to-github.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
1f5d222
)
Shell works more like the YAZ line mode client.
author
Adam Dickmeiss
<adam@indexdata.dk>
Wed, 21 Aug 1996 11:24:01 +0000
(11:24 +0000)
committer
Adam Dickmeiss
<adam@indexdata.dk>
Wed, 21 Aug 1996 11:24:01 +0000
(11:24 +0000)
iterate.tcl
patch
|
blob
|
history
shell.tcl
patch
|
blob
|
history
diff --git
a/iterate.tcl
b/iterate.tcl
index
91c9b8a
..
f95ece7
100644
(file)
--- a/
iterate.tcl
+++ b/
iterate.tcl
@@
-1,4
+1,4
@@
-# $Id: iterate.tcl,v 1.4 1995-08-04 11:32:40 adam Exp $
+# $Id: iterate.tcl,v 1.5 1996-08-21 11:24:01 adam Exp $
#
# Small test script which searches for science ...
proc fail-back {} {
#
# Small test script which searches for science ...
proc fail-back {} {
@@
-48,5
+48,5
@@
ir z
z failback {fail-back}
z databaseNames dummy
z callback {connect-response}
z failback {fail-back}
z databaseNames dummy
z callback {connect-response}
-z connect localhost:210
-
+z connect localhost:9999
+vwait forever
diff --git
a/shell.tcl
b/shell.tcl
index
d9d32d8
..
a6a1c92
100644
(file)
--- a/
shell.tcl
+++ b/
shell.tcl
@@
-1,33
+1,61
@@
-# $Id: shell.tcl,v 1.2 1995-08-28 12:21:22 adam Exp $
+# $Id: shell.tcl,v 1.3 1996-08-21 11:24:03 adam Exp $
#
source display.tcl
ir z
#
source display.tcl
ir z
+set pref(base) Default
+set pref(format) usmarc
proc help {} {
puts "Commands:"
proc help {} {
puts "Commands:"
- puts " target <host> <database>"
+ puts " target <host>"
+ puts " base <base>"
+ puts " format <format>"
puts " find <query>"
puts " show <offset> <number>"
puts ""
}
puts " find <query>"
puts " show <offset> <number>"
puts ""
}
-proc target {name database} {
+proc fail-response {} {
+ global ok
+ set ok -1
+}
+proc target {name} {
+ global ok pref
+
+ set ok 0
z disconnect
z disconnect
- z failback {puts "Connection failed"}
+ z failback {fail-response}
z callback {connect-response}
z callback {connect-response}
- z databaseNames $database
- z connect $name
+ if [catch "z connect $name"] {
+ fail-response
+ } else {
+ vwait ok
+ }
return {}
}
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 {} {
proc connect-response {} {
z callback {init-response}
z init
}
proc init-response {} {
- puts "Connect and initialized."
+ global ok pref
+
+ set ok 1
+ puts "Connected and initialized."
+ ir-set z.1 z
}
proc find-response {z} {
}
proc find-response {z} {
@@
-42,15
+70,18
@@
proc find-response {z} {
}
proc common-response {z from} {
}
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"
NSD {
puts -nonewline "NSD"
- puts -nonewline [lindex [$z responseStatus] 1]
+ puts -nonewline [lindex $status 1]
puts -nonewline " "
puts -nonewline " "
- puts -nonewline [lindex [$z responseStatus] 2]
+ puts -nonewline [lindex $status 2]
puts -nonewline ": "
puts -nonewline ": "
- puts -nonewline [lindex [$z responseStatus] 3]
+ puts -nonewline [lindex $status 3]
puts ""
}
DBOSD {
puts ""
}
DBOSD {
@@
-67,14
+98,24
@@
proc common-response {z from} {
}
proc show {from number} {
}
proc show {from number} {
+ global ok pref
+
+ set ok 0
z callback "common-response z.1 $from"
z.1 present $from $number
z callback "common-response z.1 $from"
z.1 present $from $number
+ vwait ok
+ return {}
}
proc find {query} {
}
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
z callback {find-response z.1}
z.1 search $query
+ vwait ok
+ return {}
}
}