2 # $Id: z39util.tcl,v 1.5 1995/11/08 18:07:23 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 if {[catch {set names [array names $var]}]} {
13 puts $f "set ${var} \{$v\}"
16 eval "set v \$${var}(\$n)"
17 puts $f "set ${var}($n) \{$v\}"
21 puts $f "set ${var} \{$v\}"
29 proc search-response {sno} {
32 set status [z39.$sno responseStatus]
33 if {[lindex $status 0] == "NSD"} {
34 z39.$sno nextResultSetPosition 0
35 set code [lindex $status 1]
36 set msg [lindex $status 2]
37 set addinfo [lindex $status 3]
38 html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
50 proc fail-response {} {
55 proc display-brief {zset no} {
60 set type [$zset type $no]
62 set err [lindex [$zset diag $no] 1]
63 set add [lindex [$zset diag $no] 2]
67 html "${no} Error ${err}${add} <br>\n"
74 set rtype [$zset recordType $no]
75 if {$rtype == "SUTRS"} {
76 html [join [$zset getSutrs $no]]
81 set title [lindex [$zset getMarc $no field 245 * a] 0]
82 set year [lindex [$zset getMarc $no field 260 * c] 0]
84 html {<a href="http:} $env(SCRIPT_NAME) /
85 html $sessionId {/showfull.egw/} $setNo + $no {"> } $title {</a>}
86 html " <i> ${year} </i>"
91 proc display-full {zset no} {
92 set type [$zset type $no]
94 set err [lindex [$zset diag $no] 1]
95 set add [lindex [$zset diag $no] 2]
99 html "<h3>${no}</h3>\n"
100 html "Error ${err}${add} <br>\n"
106 html "<h3>${no}</h3>\n"
107 set rtype [$zset recordType $no]
108 if {$rtype == "SUTRS"} {
109 html [join [$zset getSutrs $no]] "<br>\n"
112 if {[catch {set r [$zset getMarc $no line * * *]}]} {
113 html "Unknown record type: $rtype <br>\n"
117 set tag [lindex $line 0]
118 set indicator [lindex $line 1]
119 set fields [lindex $line 2]
120 set l [string length $indicator]
123 for {set i 0} {$i < $l} {incr i} {
124 if {[string index $indicator $i] == " "} {
127 html [string index $tag $i]
131 foreach field $fields {
132 set id [lindex $field 0]
133 set data [lindex $field 1]
135 html " <b>\$$id</b> "
143 proc display-rec {from to dfunc zz} {
146 while {$from <= $to} {
147 eval "$dfunc $zz.$setNo $from"
152 proc build-query {t} {
157 for {set i 1} {$i < 4} {incr i} {
158 set term1 [wform entry$i]
159 regsub {\+} $term1 " " term
161 set field [wform menu$i]
162 foreach x [lindex $targets($t) 2] {
163 if {[lindex $x 0] == $field} {
164 set attr [lindex $x 1]
169 { set q "@and $q ${attr} \{${term}\}" }
171 { set q "@or $q ${attr} \{${term}\}" }
173 { set q "@not $q ${attr} \{${term}\}" }
175 { set q "${attr} \{${term}\}" }
177 set op [wform logic$i]
183 proc z39search {setNo piggy} {
187 set host $hist($setNo,host)
188 if {[catch {z39 failback fail-response}]} {
191 if {[catch {set oldHost [z39 connect]}]} {
194 z39 callback ok-response
195 z39 failback fail-response
196 if {$oldHost != $host} {
197 catch {z39 disconnect}
199 html "Connecting to target " $host " <br>\n"
201 if {[catch {z39 connect $host}]} {
202 html "Cannot connect to target ${host} <br>\n"
204 } elseif {$sessionWait == 0} {
206 if {$sessionWait != 1} {
207 html "Cannot connect to target ${host} <br>\n"
211 z39 idAuthentication $hist($setNo,idAuthentication)
213 if {[catch {z39 init}]} {
214 html "Cannot initialize with target ${host} <br>\n"
217 if {[catch {zwait sessionWait 60}]} {
218 html "Cannot initialize with target ${host} <br>\n"
222 if {$sessionWait != "1"} {
223 html "Cannot initialize with target ${host} <br>\n"
228 if {![catch {z39.$setNo smallSetUpperBound 0}]} {
231 ir-set z39.$setNo z39
232 eval z39.$setNo databaseNames $hist($setNo,database)
234 z39.$setNo preferredRecordSyntax USMARC
236 z39 callback search-response $setNo
238 z39.$setNo largeSetLowerBound 999999
239 z39.$setNo smallSetUpperBound 0
240 z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
242 z39.$setNo largeSetLowerBound 2
243 z39.$setNo smallSetUpperBound 0
244 z39.$setNo mediumSetPresentNumber 0
247 z39.$setNo search $hist($setNo,query)
249 if {[catch {zwait sessionWait 600}]} {
250 html "</body></html>\n"
255 if {$sessionWait != 1} {
256 html "</body></html>\n"
260 set status [z39.$setNo responseStatus]
261 if {[lindex $status 0] == "NSD"} {
262 set code [lindex $status 1]
263 set msg [lindex $status 2]
264 set addinfo [lindex $status 3]
265 html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
268 set hist($setNo,hits) [z39.$setNo resultCount]
272 proc init-m-response {i} {
276 wlog debug "init-m-response"
282 proc connect-m-response {i} {
286 wlog debug "connect-m-response"
287 z39$i callback [list init-m-response $i]
288 if {[catch {z39$i init}]} {
294 proc fail-m-response {i} {
298 wlog debug "fail-m-response"
303 proc search-m-response {setNo i} {
311 proc z39msearch {setNo piggy} {
316 set not $hist($setNo,0,host)
318 for {set i 1} {$i <= $not} {incr i} {
319 set host $hist($setNo,$i,host)
320 if {[catch {z39 failback fail-response}]} {
323 if {[catch {set oldHost [z39$i connect]}]} {
326 if {$oldHost != $host} {
327 catch {z39$i disconnect}
329 z39$i callback [list connect-m-response $i]
330 z39$i failback [list fail-m-response $i]
333 for {set i 1} {$i <= $not} {incr i} {
334 set oldHost [z39$i connect]
335 set host $hist($setNo,$i,host)
336 if {$oldHost == $host} {
340 html "Connecting to target " $host " <br>\n"
342 if {![catch {z39$i connect $host}]} {
347 wlog debug "Waiting for init response"
348 if {[catch {zwait zleft 10}]} {
353 for {set i 1} {$i <= $not} {incr i} {
354 html "host " $hist($setNo,$i,host) ": "
355 if {$zstatus($i) >= 1} {
357 ir-set z39$i.$setNo z39$i
358 set hist($setNo,$i,offset) 0
359 eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
360 z39$i.$setNo preferredRecordSyntax USMARC
361 z39$i callback [list search-m-response $setNo $i]
364 z39$i.$setNo largeSetLowerBound 999999
365 z39$i.$setNo smallSetUpperBound 0
366 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
368 z39$i.$setNo largeSetLowerBound 2
369 z39$i.$setNo smallSetUpperBound 0
370 z39$i.$setNo mediumSetPresentNumber 0
373 wlog debug "search " $hist($setNo,$i,query)
374 z39$i.$setNo search $hist($setNo,$i,query)
381 wlog debug "Waiting for search response"
382 if {[catch {zwait zleft 30}]} {
386 for {set i 1} {$i <= $not} {incr i} {
387 if {$zstatus($i) != 2} continue
388 set status [z39$i.$setNo responseStatus]
389 if {[lindex $status 0] != "NSD"} {
390 set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
395 proc z39present {setNo setOffset setMax dfunc} {
399 set toGet [expr 1 + $setMax - $setOffset]
400 while {$setMax > 0 && $toGet > 0} {
401 for {set got 0} {$got < $toGet} {incr got} {
402 if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
408 z39.$setNo present $setOffset $toGet
409 if {[catch {zwait sessionWait 300}]} {
413 if {$sessionWait != "1"} {
416 set got [z39.$setNo numberOfRecordsReturned]
418 display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39
419 set setOffset [expr $got + $setOffset]
420 set toGet [expr 1 + $setMax - $setOffset]
432 if {![info exists nextSetNo]} {
435 html "<hr><h3>History</h3><dl>\n"
436 for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
437 html {<dt> <a href="http:} $env(SCRIPT_NAME)
438 html / $sessionId {/search.egw/} $setNo + 1
439 html + [expr $hist($setNo,maxPresent) - 1]
440 html {"> } [lindex $targets($hist($setNo,host)) 0]
441 if {[llength $hist($setNo,database)] > 1} {
443 foreach b $hist($setNo,database) {
449 if {[info exists hist($setNo,hits)]} {
450 html $hist($setNo,hits) " hits"