+#
+# $Id: z39util.tcl,v 1.1 1995/11/06 17:44:23 adam Exp $
+#
+proc saveState {} {
+ uplevel #0 {
+ set f [open "tcl.state.${sessionId}" w]
+ foreach var [info globals] {
+ if {$var == "f"} continue
+ if {$var == "sessionId"} continue
+ if {$var == "errorInfo"} continue
+ set names [array names $var]
+ if {$names != ""} {
+ foreach n $names {
+ eval "set v \$${var}(\$n)"
+ puts $f "set ${var}($n) \{$v\}"
+ }
+ } else {
+ eval "set v \$${var}"
+ puts $f "set ${var} \{$v\}"
+ }
+ }
+ close $f
+ }
+}
+
+proc search-response {sno} {
+ global sessionWait
+
+ set status [z39.$sno responseStatus]
+ if {[lindex $status 0] == "NSD"} {
+ z39.$sno nextResultSetPosition 0
+ set code [lindex $status 1]
+ set msg [lindex $status 2]
+ set addinfo [lindex $status 3]
+ html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
+ set sessionWait -2
+ } else {
+ set sessionWait 1
+ }
+}
+
+proc ok-response {} {
+ global sessionWait
+ set sessionWait 1
+}
+
+proc fail-response {} {
+ global sessionWait
+ set sessionWait -1
+}
+
+proc display-brief {zset no} {
+ global env
+ global setNo
+ global sessionId
+
+ set type [$zset type $no]
+ if {$type == "SD"} {
+ set err [lindex [$zset diag $no] 1]
+ set add [lindex [$zset diag $no] 2]
+ if {$add != {}} {
+ set add " :${add}"
+ }
+ html "${no} Error ${err}${add} <br>\n"
+ return
+ }
+ if {$type != "DB"} {
+ return
+ }
+ html "${no} "
+ set rtype [$zset recordType $no]
+ if {$rtype == "SUTRS"} {
+ html [join [$zset getSutrs $no]]
+ htmlr {<br>}
+ return
+ }
+ if {![catch {
+ set title [lindex [$zset getMarc $no field 245 * a] 0]
+ set year [lindex [$zset getMarc $no field 260 * c] 0]
+ } ] } {
+ html {<a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME) /
+ html $sessionId {/showfull.egw/} $setNo + $no {"> } $title {</a>}
+ html " <i> ${year} </i>"
+ }
+ htmlr {<br>}
+}
+
+proc display-full {zset no} {
+ set type [$zset type $no]
+ if {$type == "SD"} {
+ set err [lindex [$zset diag $no] 1]
+ set add [lindex [$zset diag $no] 2]
+ if {$add != {}} {
+ set add " :${add}"
+ }
+ htmlr "<hr> ${no} <br>"
+ htmlr "Error ${err}${add} <br>"
+ return
+ }
+ if {$type != "DB"} {
+ return
+ }
+ htmlr "<hr> ${no} <br>"
+ set rtype [$zset recordType $no]
+ if {$rtype == "SUTRS"} {
+ htmlr [join [$zset getSutrs $no]]
+ return
+ }
+ if {[catch {set r [$zset getMarc $no line * * *]}]} {
+ htmlr "Unknown record type: $rtype"
+ return
+ }
+ foreach line $r {
+ set tag [lindex $line 0]
+ set indicator [lindex $line 1]
+ set fields [lindex $line 2]
+ set l [string length $indicator]
+ html "$tag "
+ if {$l > 0} {
+ for {set i 0} {$i < $l} {incr i} {
+ if {[string index $tag $i] == " "} {
+ html "_"
+ } else {
+ html [string index $tag $i]
+ }
+ }
+ }
+ foreach field $fields {
+ set id [lindex $field 0]
+ set data [lindex $field 1]
+ if {$id != ""} {
+ html " <b>\$$id</b> "
+ }
+ html $data
+ }
+ htmlr {<br>}
+ }
+}
+
+proc display-rec {from to dfunc} {
+ global setNo
+
+ while {$from <= $to} {
+ eval "$dfunc z39.$setNo $from"
+ incr from
+ }
+}
+
+proc build-query {} {
+ global targets
+ global t
+
+ set op {}
+ set q {}
+ for {set i 1} {$i < 4} {incr i} {
+ set term1 [wform entry$i]
+ regsub {\+} $term1 " " term
+ if {$term != ""} {
+ set field [wform menu$i]
+ foreach x [lindex $targets($t) 2] {
+ if {[lindex $x 0] == $field} {
+ set attr [lindex $x 1]
+ }
+ }
+ switch $op {
+ And
+ { set q "@and $q ${attr} \{${term}\}" }
+ Or
+ { set q "@or $q ${attr} \{${term}\}" }
+ {And not}
+ { set q "@not $q ${attr} \{${term}\}" }
+ {}
+ { set q "${attr} \{${term}\}" }
+ }
+ set op [wform logic$i]
+ }
+ }
+ return $q
+}
+
+proc z39search {setNo piggy} {
+ global hist
+ global sessionWait
+
+ set host $hist($setNo,host)
+ if {[catch {z39 failback fail-response}]} {
+ ir z39
+ }
+ if {[catch {set oldHost [z39 connect]}]} {
+ set oldHost ""
+ }
+ z39 callback ok-response
+ z39 failback fail-response
+ if {$oldHost != $host} {
+ catch {z39 disconnect}
+
+ html "Connecting to target " $host " <br>\n"
+ set sessionWait 0
+ if {[catch {z39 connect $host}]} {
+ html "Cannot connect to target ${host} <br>\n"
+ return 0
+ } elseif {$sessionWait == 0} {
+ zwait sessionWait
+ if {$sessionWait != 1} {
+ html "Cannot connect to target ${host} <br>\n"
+ return 0
+ }
+ }
+ set sessionWait 0
+ if {[catch {z39 init}]} {
+ html "Cannot initialize with target ${host} <br>\n"
+ return 0
+ }
+ zwait sessionWait
+ if {$sessionWait != "1"} {
+ html "Cannot initialize with target ${host} <br>\n"
+ return 0
+ }
+ }
+ if {![catch {z39.$setNo smallSetUpperBound 0}]} {
+ return 1
+ }
+ ir-set z39.$setNo z39
+ eval z39.$setNo databaseNames $hist($setNo,database)
+
+ z39.$setNo preferredRecordSyntax USMARC
+
+ z39 callback search-response $setNo
+ if {$piggy} {
+ z39.$setNo largeSetLowerBound 999999
+ z39.$setNo smallSetUpperBound 0
+ z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
+ } else {
+ z39.$setNo largeSetLowerBound 2
+ z39.$setNo smallSetUpperBound 0
+ z39.$setNo mediumSetPresentNumber 0
+ }
+ set sessionWait 0
+ z39.$setNo search $hist($setNo,query)
+
+ zwait sessionWait
+ if {$sessionWait != 1} {
+ html "</body></html>\n"
+ return 0
+ }
+ set status [z39.$setNo responseStatus]
+ if {[lindex $status 0] == "NSD"} {
+ set code [lindex $status 1]
+ set msg [lindex $status 2]
+ set addinfo [lindex $status 3]
+ html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
+ return 0
+ }
+ set hist($setNo,hits) [z39.$setNo resultCount]
+ return 1
+}
+
+proc z39present {setNo setOffset setMax dfunc} {
+ global hist
+ global sessionWait
+
+ set toGet [expr 1 + $setMax - $setOffset]
+ while {$setMax > 0 && $toGet > 0} {
+ for {set got 0} {$got < $toGet} {incr got} {
+ if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
+ break
+ }
+ }
+ if {$got < $toGet} {
+ set sessionWait 0
+ z39.$setNo present $setOffset $toGet
+ zwait sessionWait
+ if {$sessionWait != "1"} {
+ break
+ }
+ set got [z39.$setNo numberOfRecordsReturned]
+ }
+ display-rec $setOffset [expr $got + $setOffset - 1] $dfunc
+ set setOffset [expr $got + $setOffset]
+ set toGet [expr 1 + $setMax - $setOffset]
+ wflush
+ }
+}
+
+proc z39history {} {
+ global nextSetNo
+ global hist
+ global env
+ global sessionId
+
+ if {![info exists nextSetNo]} {
+ return
+ }
+ html "<hr><h3>History</h3><dl>\n"
+ for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
+ html {<dt> <a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
+ html / $sessionId {/search.egw/} $setNo + 1
+ html + [expr $hist($setNo,maxPresent) - 1]
+ html {"> } $hist($setNo,host)
+ if {[llength $hist($setNo,database)] > 1} {
+ html ": "
+ foreach b $hist($setNo,database) {
+ html " $b"
+ }
+ }
+ html "</a>\n"
+ html "<dd> "
+ if {[info exists hist($setNo,hits)]} {
+ html $hist($setNo,hits) " hits"
+ } else {
+ html failed
+ }
+ html "\n"
+ }
+ html "</dl>\n"
+}
\ No newline at end of file