2 # $Id: z39util.tcl,v 1.3 1995/11/08 12:42:18 adam Exp $
6 set f [open "tcl.state.${sessionId}" w]
7 foreach var [info globals] {
8 if {$var == "f"} continue
9 if {$var == "sessionId"} continue
10 if {$var == "errorInfo"} continue
11 set names [array names $var]
14 eval "set v \$${var}(\$n)"
15 puts $f "set ${var}($n) \{$v\}"
19 puts $f "set ${var} \{$v\}"
26 proc search-response {sno} {
29 set status [z39.$sno responseStatus]
30 if {[lindex $status 0] == "NSD"} {
31 z39.$sno nextResultSetPosition 0
32 set code [lindex $status 1]
33 set msg [lindex $status 2]
34 set addinfo [lindex $status 3]
35 html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
47 proc fail-response {} {
52 proc display-brief {zset no} {
57 set type [$zset type $no]
59 set err [lindex [$zset diag $no] 1]
60 set add [lindex [$zset diag $no] 2]
64 html "${no} Error ${err}${add} <br>\n"
71 set rtype [$zset recordType $no]
72 if {$rtype == "SUTRS"} {
73 html [join [$zset getSutrs $no]]
78 set title [lindex [$zset getMarc $no field 245 * a] 0]
79 set year [lindex [$zset getMarc $no field 260 * c] 0]
81 html {<a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME) /
82 html $sessionId {/showfull.egw/} $setNo + $no {"> } $title {</a>}
83 html " <i> ${year} </i>"
88 proc display-full {zset no} {
89 set type [$zset type $no]
91 set err [lindex [$zset diag $no] 1]
92 set add [lindex [$zset diag $no] 2]
96 html "<h3>${no}</h3>\n"
97 html "Error ${err}${add} <br>\n"
103 html "<h3>${no}</h3>\n"
104 set rtype [$zset recordType $no]
105 if {$rtype == "SUTRS"} {
106 html [join [$zset getSutrs $no]] "<br>\n"
109 if {[catch {set r [$zset getMarc $no line * * *]}]} {
110 html "Unknown record type: $rtype <br>\n"
114 set tag [lindex $line 0]
115 set indicator [lindex $line 1]
116 set fields [lindex $line 2]
117 set l [string length $indicator]
120 for {set i 0} {$i < $l} {incr i} {
121 if {[string index $indicator $i] == " "} {
124 html [string index $tag $i]
128 foreach field $fields {
129 set id [lindex $field 0]
130 set data [lindex $field 1]
132 html " <b>\$$id</b> "
140 proc display-rec {from to dfunc zz} {
143 while {$from <= $to} {
144 eval "$dfunc $zz.$setNo $from"
149 proc build-query {t} {
154 for {set i 1} {$i < 4} {incr i} {
155 set term1 [wform entry$i]
156 regsub {\+} $term1 " " term
158 set field [wform menu$i]
159 foreach x [lindex $targets($t) 2] {
160 if {[lindex $x 0] == $field} {
161 set attr [lindex $x 1]
166 { set q "@and $q ${attr} \{${term}\}" }
168 { set q "@or $q ${attr} \{${term}\}" }
170 { set q "@not $q ${attr} \{${term}\}" }
172 { set q "${attr} \{${term}\}" }
174 set op [wform logic$i]
180 proc z39search {setNo piggy} {
184 set host $hist($setNo,host)
185 if {[catch {z39 failback fail-response}]} {
188 if {[catch {set oldHost [z39 connect]}]} {
191 z39 callback ok-response
192 z39 failback fail-response
193 if {$oldHost != $host} {
194 catch {z39 disconnect}
196 html "Connecting to target " $host " <br>\n"
198 if {[catch {z39 connect $host}]} {
199 html "Cannot connect to target ${host} <br>\n"
201 } elseif {$sessionWait == 0} {
203 if {$sessionWait != 1} {
204 html "Cannot connect to target ${host} <br>\n"
208 z39 idAuthentication $hist($setNo,idAuthentication)
210 if {[catch {z39 init}]} {
211 html "Cannot initialize with target ${host} <br>\n"
215 if {$sessionWait != "1"} {
216 html "Cannot initialize with target ${host} <br>\n"
220 if {![catch {z39.$setNo smallSetUpperBound 0}]} {
223 ir-set z39.$setNo z39
224 eval z39.$setNo databaseNames $hist($setNo,database)
226 z39.$setNo preferredRecordSyntax USMARC
228 z39 callback search-response $setNo
230 z39.$setNo largeSetLowerBound 999999
231 z39.$setNo smallSetUpperBound 0
232 z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
234 z39.$setNo largeSetLowerBound 2
235 z39.$setNo smallSetUpperBound 0
236 z39.$setNo mediumSetPresentNumber 0
239 z39.$setNo search $hist($setNo,query)
242 if {$sessionWait != 1} {
243 html "</body></html>\n"
246 set status [z39.$setNo responseStatus]
247 if {[lindex $status 0] == "NSD"} {
248 set code [lindex $status 1]
249 set msg [lindex $status 2]
250 set addinfo [lindex $status 3]
251 html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
254 set hist($setNo,hits) [z39.$setNo resultCount]
258 proc init-m-response {i} {
262 wlog debug "init-m-response"
268 proc connect-m-response {i} {
272 wlog debug "connect-m-response"
273 z39$i callback [list init-m-response $i]
274 if {[catch {z39$i init}]} {
280 proc fail-m-response {i} {
284 wlog debug "fail-m-response"
289 proc search-m-response {setNo i} {
297 proc z39msearch {setNo piggy} {
302 set not $hist($setNo,0,host)
304 for {set i 1} {$i <= $not} {incr i} {
305 set host $hist($setNo,$i,host)
306 if {[catch {z39 failback fail-response}]} {
309 if {[catch {set oldHost [z39$i connect]}]} {
312 if {$oldHost != $host} {
313 catch {z39$i disconnect}
315 z39$i callback [list connect-m-response $i]
316 z39$i failback [list fail-m-response $i]
319 for {set i 1} {$i <= $not} {incr i} {
320 set oldHost [z39$i connect]
321 set host $hist($setNo,$i,host)
322 if {$oldHost == $host} {
326 html "Connecting to target " $host " <br>\n"
328 if {![catch {z39$i connect $host}]} {
333 wlog debug "Waiting for init response"
334 if {[catch {zwait zleft 10}]} {
339 for {set i 1} {$i <= $not} {incr i} {
340 html "host " $hist($setNo,$i,host) ": "
341 if {$zstatus($i) >= 1} {
343 ir-set z39$i.$setNo z39$i
344 set hist($setNo,$i,offset) 0
345 eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
346 z39$i.$setNo preferredRecordSyntax USMARC
347 z39$i callback [list search-m-response $setNo $i]
350 z39$i.$setNo largeSetLowerBound 999999
351 z39$i.$setNo smallSetUpperBound 0
352 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
354 z39$i.$setNo largeSetLowerBound 2
355 z39$i.$setNo smallSetUpperBound 0
356 z39$i.$setNo mediumSetPresentNumber 0
359 wlog debug "search " $hist($setNo,$i,query)
360 z39$i.$setNo search $hist($setNo,$i,query)
367 wlog debug "Waiting for search response"
368 if {[catch {zwait zleft 30}]} {
372 for {set i 1} {$i <= $not} {incr i} {
373 if {$zstatus($i) != 2} continue
374 set status [z39$i.$setNo responseStatus]
375 if {[lindex $status 0] != "NSD"} {
376 set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
381 proc z39present {setNo setOffset setMax dfunc} {
385 set toGet [expr 1 + $setMax - $setOffset]
386 while {$setMax > 0 && $toGet > 0} {
387 for {set got 0} {$got < $toGet} {incr got} {
388 if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
394 z39.$setNo present $setOffset $toGet
396 if {$sessionWait != "1"} {
399 set got [z39.$setNo numberOfRecordsReturned]
401 display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39
402 set setOffset [expr $got + $setOffset]
403 set toGet [expr 1 + $setMax - $setOffset]
415 if {![info exists nextSetNo]} {
418 html "<hr><h3>History</h3><dl>\n"
419 for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
420 html {<dt> <a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
421 html / $sessionId {/search.egw/} $setNo + 1
422 html + [expr $hist($setNo,maxPresent) - 1]
423 html {"> } [lindex $targets($hist($setNo,host)) 0]
424 if {[llength $hist($setNo,database)] > 1} {
426 foreach b $hist($setNo,database) {
432 if {[info exists hist($setNo,hits)]} {
433 html $hist($setNo,hits) " hits"