5c81b13d138cebf94187cfd18525f629c7d87c49
[egate.git] / www / z39util.tcl
1 #
2 # $Id: z39util.tcl,v 1.4 1995/11/08 16:14:36 adam Exp $
3 #
4 proc saveState {} {
5     uplevel #0 {
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]}]} {
12             eval "set v \$${var}"
13             puts $f "set ${var} \{$v\}"
14         } else {
15             foreach n $names {
16                 eval "set v \$${var}(\$n)"
17                 puts $f "set ${var}($n) \{$v\}"
18             }
19         }
20     }
21     close $f
22     }
23 }
24
25 proc search-response {sno} {
26     global sessionWait
27
28     set status [z39.$sno responseStatus]
29     if {[lindex $status 0] == "NSD"} {
30         z39.$sno nextResultSetPosition 0
31         set code [lindex $status 1]
32         set msg [lindex $status 2]
33         set addinfo [lindex $status 3]
34         html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
35         set sessionWait -2
36     } else {
37         set sessionWait 1
38     }
39 }
40
41 proc ok-response {} {
42     global sessionWait
43     set sessionWait 1
44 }
45
46 proc fail-response {} {
47     global sessionWait
48     set sessionWait -1
49 }
50
51 proc display-brief {zset no} {
52     global env
53     global setNo
54     global sessionId
55
56     set type [$zset type $no]
57     if {$type == "SD"} {
58         set err [lindex [$zset diag $no] 1]
59         set add [lindex [$zset diag $no] 2]
60         if {$add != {}} {
61             set add " :${add}"
62         }
63         html "${no} Error ${err}${add} <br>\n"
64         return
65     }
66     if {$type != "DB"} {
67         return
68     }
69     html "${no} "
70     set rtype [$zset recordType $no]
71     if {$rtype == "SUTRS"} {
72         html [join [$zset getSutrs $no]]
73         html "<br>\n"
74         return
75     } 
76     if {![catch {
77         set title [lindex [$zset getMarc $no field 245 * a] 0]
78         set year [lindex [$zset getMarc $no field 260 * c] 0]
79     } ] } {
80         html {<a href="http:} $env(SCRIPT_NAME) /
81         html $sessionId {/showfull.egw/} $setNo + $no {"> } $title {</a>}
82         html " <i> ${year} </i>"
83     }
84     html "<br>\n"
85 }
86
87 proc display-full {zset no} {
88     set type [$zset type $no]
89     if {$type == "SD"} {
90         set err [lindex [$zset diag $no] 1]
91         set add [lindex [$zset diag $no] 2]
92         if {$add != {}} {
93             set add " :${add}"
94         }
95         html "<h3>${no}</h3>\n"
96         html "Error ${err}${add} <br>\n"
97         return
98     }
99     if {$type != "DB"} {
100         return
101     }
102     html "<h3>${no}</h3>\n"
103     set rtype [$zset recordType $no]
104     if {$rtype == "SUTRS"} {
105         html [join [$zset getSutrs $no]] "<br>\n"
106         return
107     } 
108     if {[catch {set r [$zset getMarc $no line * * *]}]} {
109         html "Unknown record type: $rtype <br>\n"
110         return
111     }
112     foreach line $r {
113         set tag [lindex $line 0]
114         set indicator [lindex $line 1]
115         set fields [lindex $line 2]
116         set l [string length $indicator]
117         html "$tag "
118         if {$l > 0} {
119             for {set i 0} {$i < $l} {incr i} {
120                 if {[string index $indicator $i] == " "} {
121                     html "-"
122                 } else {
123                     html [string index $tag $i]
124                 }
125             }
126         }
127         foreach field $fields {
128             set id [lindex $field 0]
129             set data [lindex $field 1]
130             if {$id != ""} {
131                 html " <b>\$$id</b> "
132             }
133             html $data
134         }
135         htmlr {<br>}
136     }
137 }
138
139 proc display-rec {from to dfunc zz} {
140     global setNo
141
142     while {$from <= $to} { 
143         eval "$dfunc $zz.$setNo $from"
144         incr from
145     }
146 }
147
148 proc build-query {t} {
149     global targets
150
151     set op {}
152     set q {}
153     for {set i 1} {$i < 4} {incr i} {
154         set term1 [wform entry$i]
155         regsub {\+} $term1 " " term
156         if {$term != ""} {
157             set field [wform menu$i]
158             foreach x [lindex $targets($t) 2] {
159                 if {[lindex $x 0] == $field} {
160                     set attr [lindex $x 1]
161                 }
162             }
163             switch $op {
164             And
165                 { set q "@and $q ${attr} \{${term}\}" }
166             Or
167                 { set q "@or $q ${attr} \{${term}\}" }
168             {And not}
169                 { set q "@not $q ${attr} \{${term}\}" }
170             {}
171                 { set q "${attr} \{${term}\}" }
172             }
173             set op [wform logic$i]
174         }
175     }
176     return $q
177 }
178
179 proc z39search {setNo piggy} {
180     global hist
181     global sessionWait
182
183     set host $hist($setNo,host)
184     if {[catch {z39 failback fail-response}]} {
185         ir z39
186     }
187     if {[catch {set oldHost [z39 connect]}]} {
188         set oldHost ""
189     }
190     z39 callback ok-response
191     z39 failback fail-response
192     if {$oldHost != $host} {
193         catch {z39 disconnect}
194
195         html "Connecting to target " $host " <br>\n"
196         set sessionWait 0
197         if {[catch {z39 connect $host}]} {
198             html "Cannot connect to target ${host} <br>\n"
199             return 0
200         } elseif {$sessionWait == 0} {
201             zwait sessionWait
202             if {$sessionWait != 1} {
203                 html "Cannot connect to target ${host} <br>\n"
204                 return 0
205             }
206         }
207         z39 idAuthentication $hist($setNo,idAuthentication)
208         set sessionWait 0
209         if {[catch {z39 init}]} {
210             html "Cannot initialize with target ${host} <br>\n"
211             return 0
212         }
213         if {[catch {zwait sessionWait 60}]} {
214             html "Cannot initialize with target ${host} <br>\n"
215             z39 disconnect
216             return 0
217         }
218         if {$sessionWait != "1"} {
219             html "Cannot initialize with target ${host} <br>\n"
220             z39 disconnect
221             return 0
222         }
223     }
224     if {![catch {z39.$setNo smallSetUpperBound 0}]} {
225         return 1
226     }
227     ir-set z39.$setNo z39
228     eval z39.$setNo databaseNames $hist($setNo,database)
229
230     z39.$setNo preferredRecordSyntax USMARC
231
232     z39 callback search-response $setNo
233     if {$piggy} {
234         z39.$setNo largeSetLowerBound 999999
235         z39.$setNo smallSetUpperBound 0
236         z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
237     } else {
238         z39.$setNo largeSetLowerBound 2
239         z39.$setNo smallSetUpperBound 0
240         z39.$setNo mediumSetPresentNumber 0
241     }
242     set sessionWait 0
243     z39.$setNo search $hist($setNo,query)
244
245     if {[catch {zwait sessionWait 600}]} {
246         html "</body></html>\n"
247         z39 disconnect
248         return 0
249     }
250         
251     if {$sessionWait != 1} {
252         html "</body></html>\n"
253         z39 disconnect
254         return 0
255     }
256     set status [z39.$setNo responseStatus]
257     if {[lindex $status 0] == "NSD"} {
258         set code [lindex $status 1]
259         set msg [lindex $status 2]
260         set addinfo [lindex $status 3]
261         html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
262         return 0
263     }
264     set hist($setNo,hits) [z39.$setNo resultCount]
265     return 1
266 }
267
268 proc init-m-response {i} {
269     global zstatus
270     global zleft
271
272     wlog debug "init-m-response"
273
274     set zstatus($i) 1
275     incr zleft -1
276 }
277
278 proc connect-m-response {i} {
279     global zstatus
280     global zleft
281
282     wlog debug "connect-m-response"
283     z39$i callback [list init-m-response $i]
284     if {[catch {z39$i init}]} {
285         set zstatus($i) -1
286         incr zleft -1
287     }
288 }
289
290 proc fail-m-response {i} {
291     global zstatus
292     global zleft
293     
294     wlog debug "fail-m-response"
295     set zstatus($i) -1
296     incr zleft -1
297 }
298
299 proc search-m-response {setNo i} {
300     global zleft
301     global zstatus
302
303     incr zleft -1
304     set zstatus($i) 2
305 }
306
307 proc z39msearch {setNo piggy} {
308     global zleft
309     global zstatus
310     global hist
311
312     set not $hist($setNo,0,host)
313
314     for {set i 1} {$i <= $not} {incr i} {
315         set host $hist($setNo,$i,host)
316         if {[catch {z39 failback fail-response}]} {
317             ir z39$i
318         }
319         if {[catch {set oldHost [z39$i connect]}]} {
320             set oldHost ""
321         }
322         if {$oldHost != $host} {
323             catch {z39$i disconnect}
324         }
325         z39$i callback [list connect-m-response $i]
326         z39$i failback [list fail-m-response $i]
327     }
328     set zleft 0
329     for {set i 1} {$i <= $not} {incr i} {
330         set oldHost [z39$i connect]
331         set host $hist($setNo,$i,host)
332         if {$oldHost == $host} {
333             set zstatus($i) 1
334             continue
335         }
336         html "Connecting to target " $host " <br>\n"
337         set zstatus($i) -1
338         if {![catch {z39$i connect $host}]} {
339             incr zleft
340         } 
341     }
342     while {$zleft > 0} {
343         wlog debug "Waiting for init response"
344         if {[catch {zwait zleft 10}]} {
345             break
346         }
347     }
348     set zleft 0
349     for {set i 1} {$i <= $not} {incr i} {
350         html "host " $hist($setNo,$i,host) ": "
351         if {$zstatus($i) >= 1} {
352             html "ok <br>\n"
353             ir-set z39$i.$setNo z39$i
354             set hist($setNo,$i,offset) 0
355             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
356             z39$i.$setNo preferredRecordSyntax USMARC
357             z39$i callback [list search-m-response $setNo $i]
358
359             if {$piggy} {
360                 z39$i.$setNo largeSetLowerBound 999999
361                 z39$i.$setNo smallSetUpperBound 0
362                 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
363             } else {
364                 z39$i.$setNo largeSetLowerBound 2
365                 z39$i.$setNo smallSetUpperBound 0
366                 z39$i.$setNo mediumSetPresentNumber 0
367             }
368             set zstatus($i) 1
369             wlog debug "search " $hist($setNo,$i,query)
370             z39$i.$setNo search $hist($setNo,$i,query)
371             incr zleft
372         } else {
373             html "fail <br>\n"
374         }
375     }
376     while {$zleft > 0} {
377         wlog debug "Waiting for search response"
378         if {[catch {zwait zleft 30}]} {
379             break
380         }
381     }
382     for {set i 1} {$i <= $not} {incr i} {
383         if {$zstatus($i) != 2} continue
384         set status [z39$i.$setNo responseStatus]
385         if {[lindex $status 0] != "NSD"} {
386             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
387         }
388     }
389 }
390
391 proc z39present {setNo setOffset setMax dfunc} {
392     global hist
393     global sessionWait
394
395     set toGet [expr 1 + $setMax - $setOffset]
396     while {$setMax > 0 && $toGet > 0} {
397         for {set got 0} {$got < $toGet} {incr got} {
398             if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
399                 break
400             }
401         }
402         if {$got < $toGet} {
403             set sessionWait 0
404             z39.$setNo present $setOffset $toGet
405             if {[catch {zwait sessionWait 300}]} {
406                 z39 disconnect
407                 break
408             }
409             if {$sessionWait != "1"} {
410                 break
411             }
412             set got [z39.$setNo numberOfRecordsReturned]
413         }
414         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39
415         set setOffset [expr $got + $setOffset]
416         set toGet [expr 1 + $setMax - $setOffset]
417         wflush
418     }
419 }
420
421 proc z39history {} {
422     global nextSetNo
423     global hist
424     global env
425     global sessionId
426     global targets
427
428     if {![info exists nextSetNo]} {
429         return
430     }
431     html "<hr><h3>History</h3><dl>\n"
432     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
433         html {<dt> <a href="http:} $env(SCRIPT_NAME)
434         html / $sessionId {/search.egw/} $setNo + 1
435         html + [expr $hist($setNo,maxPresent) - 1]
436         html {"> } [lindex $targets($hist($setNo,host)) 0]
437         if {[llength $hist($setNo,database)] > 1} {
438             html ": "
439             foreach b $hist($setNo,database) {
440                 html " $b"
441             }
442         }
443         html "</a>\n"
444         html "<dd> "
445         if {[info exists hist($setNo,hits)]} {
446             html $hist($setNo,hits) " hits"
447         } else {
448             html failed
449         }
450         html "\n"
451     }
452     html "</dl>\n"
453 }