All tcl commands prefixed with egw_ (except the html command).
[egate.git] / www / z39util.tcl
1 #
2 # $Id: z39util.tcl,v 1.22 1996/01/23 14:22:03 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             catch {
20                 eval "set v \$${var}"
21                 puts $f "set ${var} \{$v\}"
22             }
23         }
24     }
25     close $f
26     }
27 }
28
29 proc search-response {zz} {
30     global sessionWait
31
32     set status [$zz responseStatus]
33     if {[lindex $status 0] == "NSD"} {
34         $zz nextResultSetPosition 0
35         set code [lindex $status 1]
36         set msg [lindex $status 2]
37         set addinfo [lindex $status 3]
38         displayError "Diagnostic message" \
39                 "$msg: $addinfo<br>\n(error code $code)"
40         set sessionWait -2
41     } else {
42         set sessionWait 1
43     }
44 }
45
46 proc scan-response {zz} {
47     global sessionWait
48
49     set status [$zz scanStatus]
50     if {$status == 6} {
51         displayError "Scan fail" ""
52         set sessionWait -2
53     } else {
54         set sessionWait 1
55     }
56 }
57
58 proc ok-response {} {
59     global sessionWait
60     set sessionWait 1
61 }
62
63 proc fail-response {} {
64     global sessionWait
65     set sessionWait -1
66 }
67
68 proc display-brief {zset no tno} {
69     global env
70     global setNo
71     global sessionId
72
73
74     html {<li>}
75     set type [$zset type $no]
76     if {$type == "SD"} {
77         set err [lindex [$zset diag $no] 1]
78         set add [lindex [$zset diag $no] 2]
79         if {$add != {}} {
80             set add " :${add}"
81         }
82         html "${no} Error ${err}${add} <br>\n"
83         return
84     }
85     if {$type != "DB"} {
86         return
87     }
88     set rtype [$zset recordType $no]
89     if {$rtype == "SUTRS"} {
90         html [join [$zset getSutrs $no]]
91         html "<br>\n"
92         return
93     } 
94     if {![catch {
95         set author [$zset getMarc $no field 100 * a]
96         set corp [$zset getMarc $no field 110 * a]
97         set meet [$zset getMarc $no field 111 * a]
98         set title [$zset getMarc $no field 245 * a]
99         if {[llength $author] == 0} {
100             set cover [$zset getMarc $no field 245 * {[bc]}]
101         } else {
102             set cover [$zset getMarc $no field 245 * b]
103         }
104         set location [$zset getMarc $no field 260 * a] 
105         set publisher [$zset getMarc $no field 260 * b]
106         set year [$zset getMarc $no field 260 * c]
107     } ] } {
108         set p 0
109         foreach a $author {
110             if {$p} {
111                 html ", "
112             }
113             html $a
114             set p 1
115         }
116         foreach a $corp {
117             if {$p} {
118                 html ", "
119             }
120             html $a
121             set p 1
122         }
123         foreach a $meet {
124             if {$p} {
125                 html ", "
126             }
127             html $a
128             set p 1
129         }
130         if {$p} {
131             html ": "
132         }
133         html {<em>}
134         set nope 1
135         foreach v $title {
136             html $v
137             set nope 0
138         }
139         if {$nope} {
140             html {No title} 
141         }
142         html {</em> }
143         foreach v $cover {
144             html $v
145         }
146         html {<br>}
147         foreach v $location {
148             html " $v"
149         }
150         foreach v $publisher {
151             html " $v"
152         }
153         foreach v $year {
154             html " $v"
155         }
156         html { -- <a href="http:} $env(SCRIPT_NAME) /
157         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
158         html "<em>view full</em></a>"
159     }
160     html "<br>\n"
161 }
162
163 proc display-raw {zset no tno} {
164     set type [$zset type $no]
165     if {$type == "SD"} {
166         set err [lindex [$zset diag $no] 1]
167         set add [lindex [$zset diag $no] 2]
168         if {$add != {}} {
169             set add " :${add}"
170         }
171         html "<h3>${no}</h3>\n"
172         html "Error ${err}${add} <br>\n"
173         return
174     }
175     if {$type != "DB"} {
176         return
177     }
178     set rtype [$zset recordType $no]
179     if {$rtype == "SUTRS"} {
180         html [join [$zset getSutrs $no]] "<br>\n"
181         return
182     } 
183     if {[catch {set r [$zset getMarc $no line * * *]}]} {
184         html "Unknown record type: $rtype <br>\n"
185         return
186     }
187     foreach line $r {
188         set tag [lindex $line 0]
189         set indicator [lindex $line 1]
190         set fields [lindex $line 2]
191         set l [string length $indicator]
192         html "<tt>$tag "
193         if {$l > 0} {
194             for {set i 0} {$i < $l} {incr i} {
195                 if {[string index $indicator $i] == " "} {
196                     html "-"
197                 } else {
198                     html [string index $tag $i]
199                 }
200             }
201         }
202         html "</tt>"
203         foreach field $fields {
204             set id [lindex $field 0]
205             set data [lindex $field 1]
206             if {$id != ""} {
207                 html " <b>\$$id</b> "
208             }
209             html $data
210         }
211         htmlr {<br>}
212     }
213 }
214
215 proc put-marc-contents {cc} {
216     set ref ""
217     if {[string first :// $cc] > 0} {
218         foreach urltype {gopher http ftp mailto} {
219             if {[string first ${urltype}:// $cc] == 0} {
220                 set ref $urltype
221                 break
222             }
223         }
224     } 
225     if {$ref != ""} {
226         html {<a href="}
227     }
228     html $cc
229     if {$ref != ""} {
230         html {">} $cc {</a>}
231     }
232 }
233
234 proc dl-marc-field {zset no tag id la lb sep} {
235     set n 0
236     set c [$zset getMarc $no field $tag * $id]
237     set len [llength $c]
238     if {$len == 0} {
239         return 0
240     }
241     if {$len > 1 && "x$lb" != "x"} {
242         html "<dt><b>$lb</b>\n<dd>"
243     } else {
244         html "<dt><b>$la</b>\n<dd>"
245     }
246     foreach cc $c {
247         if {$n > 0} {
248             html $sep
249         }
250         put-marc-contents $cc
251         incr n
252     }
253     return $n
254 }
255
256 proc dd-marc-field {zset no tag id start stop} {
257     set n 0
258     set c [$zset getMarc $no field $tag * $id]
259     set len [llength $c]
260     if {$len == 0} {
261         return 0
262     }
263     foreach cc $c {
264         html $start
265         put-marc-contents $cc
266         html $stop
267         incr n
268     }
269     return $n
270 }
271
272 proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
273     set n 0
274     set lines [$zset getMarc $no line $tag * *]
275     foreach line $lines {
276         foreach field [lindex $line 2] {
277             if {$n == 0} {
278                 html "<dt><b>$lead</b>"
279                 html "\n<dd>"
280             }
281             set id [lindex $field 0]
282             if {$id == $startid} {
283                 if {$n > 0} {
284                     html $stop
285                 }
286                 html $start
287                 incr n
288                 html [lindex $field 1]
289             } else {
290                 html $sep
291                 html [lindex $field 1]
292             }
293         }
294     }
295     if {$n > 0} {
296         html $stop
297     }
298 }
299
300 proc display-full {zset no tno} {
301     set type [$zset type $no]
302     if {$type == "SD"} {
303         set err [lindex [$zset diag $no] 1]
304         set add [lindex [$zset diag $no] 2]
305         if {$add != {}} {
306             set add " :${add}"
307         }
308         html "Error ${err}${add} <br>\n"
309         return
310     }
311     if {$type != "DB"} {
312         return
313     }
314     set rtype [$zset recordType $no]
315     if {$rtype == "SUTRS"} {
316         html [join [$zset getSutrs $no]] "<br>\n"
317         return
318     } 
319     if {[catch {set r [$zset getMarc $no line * * *]}]} {
320         html "Unknown record type: $rtype <br>\n"
321         return
322     }
323     html "<dl>\n"
324     set n [dl-marc-field $zset $no 700 a "Author" "Authors" "<br>\n"]
325     if {$n == 0} {
326         set n [dl-marc-field $zset $no 100 a "Author" "Authors" "<br>\n"]
327     }
328     set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
329     if {$n == 0} {
330         set n [dl-marc-field $zset $no 110 a "Corporate Name" {} ", "]
331     }
332     set n [dl-marc-field $zset $no 711 a "Meeting Name" {} ", "]
333     if {$n > 0} {
334         dd-marc-field $zset $no 711 {[bndc]} " " ""
335     } else {
336         set n [dl-marc-field $zset $no 111 a "Meeting Name" {} ", "]
337         if {$n > 0} {
338             dd-marc-field $zset $no 111 {[bndc]} " " " "
339         }
340     } 
341     set n [dl-marc-field $zset $no 245 {a} "Title" {} " "]
342     if {$n > 0} {
343         dd-marc-field $zset $no 245 b "<em>" "</em>"
344         dd-marc-field $zset $no 245 c " " ""
345     } else {
346         dl-marc-field $zset $no 245 {[ab]} "Title" {} " "
347     }
348     dl-marc-field $zset $no 520 a "Abstract" {} ", "
349     dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", "
350     dl-marc-field $zset $no 650 * "Subject" {} ", "
351     dl-marc-field $zset $no 260 * "Publisher" {} " "
352     dl-marc-field $zset $no 300 * "Physical Description" {} " "
353
354     dl-marc-field-rec $zset $no 500 "Notes" "" "<br>\n" "a" ", "
355
356     dl-marc-field-rec $zset $no 510 "References" "" "<br>\n" "a" ", "
357
358     dl-marc-field-rec $zset $no 511 "Participant note" "" "<br>\n" "a" ", "
359
360     dl-marc-field $zset $no 513 a "Report type" {} ", "
361     dl-marc-field $zset $no 513 b "Period covered" {} ", "
362     dl-marc-field-rec $zset $no 515 "Numbering notes" "" "<br>\n" "a" ", "
363     dl-marc-field-rec $zset $no 516 "Data notes" "" "<br>\n" "a" ", "
364     dl-marc-field-rec $zset $no 518 "Date/time notes" "" "<br>\n" "a" ", "
365
366     dl-marc-field $zset $no 350 a "Price" {} ", "
367     dl-marc-field $zset $no 362 a "Dates of publication" {} ", "
368     dl-marc-field $zset $no 850 a "Holdings" {} ", "
369
370     dl-marc-field-rec $zset $no 270 "Contact name" "" "<br>\n" p ", "
371     if {0} {
372         set n [dl-marc-field $zset $no 270 p "Contact name" {} ", "]
373         if {$n > 0} {
374             html "\n<dl>\n"
375             
376             if {0} {
377                 dl-marc-field $zset $no 270 a "Street" {} ", "
378                 dl-marc-field $zset $no 270 b "City" {} ", "
379                 dl-marc-field $zset $no 270 c "State" {} ", "
380                 dl-marc-field $zset $no 270 e "Zip code" {} ", "
381                 dl-marc-field $zset $no 270 d "Country" {} ", "
382                 dl-marc-field $zset $no 270 m "Network address" {} ", "
383                 dl-marc-field $zset $no 301 a "Service hours" {} ", "
384                 dl-marc-field $zset $no 270 k "Phone" {} ", "
385                 dl-marc-field $zset $no 270 l "Fax" {} ", "
386             } else {
387                 dl-marc-field $zset $no 270 {[abcedmakl]} "Address" {} "<br>\n"
388             }
389             
390             html "\n</dl>\n"
391         }
392     }
393     dl-marc-field $zset $no 010 a "LC control number" {} ", "
394     dl-marc-field $zset $no 010 b "NUCMC control number" {} ", "
395     dl-marc-field $zset $no 020 a "ISBN" {} ", "
396     dl-marc-field $zset $no 022 a "ISSN" {} ", "
397     set url [$zset getMarc $no field 856 * u]
398     set sp [$zset getMarc $no field 856 * 3]
399     if {"x$url" != "x"} {
400         html "<dt><b>URL</b>\n"
401         if {"x$sp" == "x"} {
402             set sp $url
403         }
404         html {<dd><a href="} $url {">} [join $sp] "</a>\n"
405     }
406     dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "<br>\n"
407     dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "<br>\n"
408     dl-marc-field $zset $no 537 * "Source of data" {} "<br>\n"
409     dl-marc-field $zset $no 538 * "System details" {} "<br>\n"
410     dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "<br>\n"
411     dl-marc-field $zset $no 001 * "Local control number" {} ", "
412     html "</dl>\n"
413 }
414
415
416 proc display-rec {from to dfunc tno} {
417     global setNo
418
419     if {$tno > 0} {
420         while {$from <= $to} { 
421             eval "$dfunc z39${tno}.${setNo} $from $tno"
422             incr from
423         }
424     } else {
425         while {$from <= $to} { 
426             eval "$dfunc z39.${setNo} $from 0"
427             incr from
428         }
429     }
430 }
431
432 proc build-scan {t i} {
433     global targets
434
435     set term [wform entry$i]
436     if {$term != ""} {
437         set field [join [wform menu$i]]
438         set attr {Title}
439         foreach x [lindex $targets($t) 2] {
440             if {[lindex $x 0] == $field} {
441                 set attr [lindex $x 1]
442             }
443         }
444         return [list $term $attr]
445     }
446     return ""
447 }
448
449 proc build-query {t ilines} {
450     global targets
451
452     set op {}
453     set q {}
454     for {set i 1} {$i <= $ilines} {incr i} {
455         set term [join [wform entry$i]]
456         if {[string length $term] > 0} {
457             set field [join [wform menu$i]]
458             foreach x [lindex $targets($t) 2] {
459                 if {[lindex $x 0] == $field} {
460                     set attr [lindex $x 1]
461                 }
462             }
463             switch $op {
464             And
465                 { set q "@and $q ${attr} ${term}" }
466             Or
467                 { set q "@or $q ${attr} ${term}" }
468             {And not}
469                 { set q "@not $q ${attr} ${term}" }
470             {}
471                 { set q "${attr} ${term}" }
472             }
473             set op [wform logic$i]
474         }
475     }
476     return $q
477 }
478
479 proc z39scan {setNo scanNo tno scanLines scanPos cache} {
480     global hist
481     global sessionWait
482     global targets
483
484     if {$tno > 0} {
485         set zz z39$tno
486         set host $hist($setNo,$tno,host)
487         set idAuth $hist($setNo,$tno,idAuthentication)
488         set database $hist($setNo,$tno,database)
489         set scanAttr $hist($setNo,$tno,scanAttr)
490         set scanTerm $hist($setNo,$tno,$scanNo,scanTerm)
491     } else {
492         set zz z39
493         set host $hist($setNo,host)
494         set idAuth $hist($setNo,idAuthentication)
495         set database $hist($setNo,database)
496         set scanAttr $hist($setNo,scanAttr)
497         set scanTerm $hist($setNo,$scanNo,scanTerm)
498     }
499     if {[catch [list $zz failback fail-response]]} {
500         ir $zz
501     }
502     if {[catch [list set oldHost [$zz connect]]]} {
503         set oldHost ""
504     }
505     set zs $zz.s$scanNo.$setNo
506     $zz callback ok-response
507     $zz failback fail-response
508     if {$oldHost != $host} {
509         catch [list $zz disconnect]
510
511         set sessionWait 0
512         if {[catch [list $zz connect $host]]} {
513             displayError "Cannot connect to target" $host
514             return 0
515         } elseif {$sessionWait == 0} {
516             if {[catch {zwait sessionWait 300}]} {
517                 $zz disconnect
518                 displayError "Cannot connect to target" $host
519                 return 0
520             }
521             if {$sessionWait != 1} {
522                 displayError "Cannot connect to target" $host
523                 return 0
524             }
525         }
526         $zz idAuthentication $idAuth
527         set sessionWait 0
528         if {[catch {$zz init}]} {
529             displayError "Cannot initialize target" $host
530             $zz disconnect
531             return 0
532         }
533         if {[catch {zwait sessionWait 60}]} {
534             displayError "Cannot initialize target" $host
535             $zz disconnect
536             return 0
537         }
538         if {$sessionWait != "1"} {
539             displayError "Cannot initialize target" $host
540             $zz disconnect
541             return 0
542         }
543         if {![$zz initResult]} {
544             set u [$zz userInformationField]
545             $zz disconnect
546             displayError "Cannot initialize target $host" $u
547             return 0
548         }
549     } else {
550         if {$cache && ![catch [list $zs numberOfTermsRequested 5]]} {
551             return 1
552         }
553     }
554     eval $zz databaseNames $database
555
556     ir-scan $zs $zz
557
558     $zs numberOfTermsRequested $scanLines
559     $zs preferredPositionInResponse $scanPos
560
561     $zz callback [list scan-response $zs]
562
563     set sessionWait 0
564     $zs scan "${scanAttr} ${scanTerm}"
565
566     if {[catch {zwait sessionWait 60}]} {
567         wlog debug "timeout/cancel in scan"
568         displayError "Timeout in scan" {}
569         html "</body></html>\n"
570         $zz disconnect
571         return 0
572     }
573     if {$sessionWait == -1} {
574         displayError "Scan fail" "Connection closed"
575         html "</body></html>\n"
576         $zz disconnect
577     }
578     if {$sessionWait != 1} {
579         return 0
580     }
581     return 1
582 }
583
584 proc display-scan {setNo scanNo tno} {
585     global hist
586     global targets
587     global env
588     global sessionId
589
590     if {$tno > 0} {
591         set zz z39$tno
592     } else {
593         set zz z39
594     }
595     set zs $zz.s$scanNo.$setNo
596     set m [$zs numberOfEntriesReturned]
597         
598     if {$m > 0} {
599         set t [lindex [$zs scanLine 0] 1]
600         if {$tno > 0} {
601             set hist($setNo,$tno,[expr $scanNo - 1],scanTerm) $t
602         } else {
603             set hist($setNo,[expr $scanNo - 1],scanTerm) $t
604         }
605         set t [lindex [$zs scanLine [expr $m - 1]] 1]
606         if {$tno > 0} {
607             set hist($setNo,$tno,[expr $scanNo + 1],scanTerm) $t
608         } else {
609             set hist($setNo,[expr $scanNo + 1],scanTerm) $t
610         }
611     }
612     for {set i 0} {$i < $m} {incr i} {
613         regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
614         html {<a href="http:} $env(SCRIPT_NAME)
615         html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo +
616         html $hist($setNo,scan) +  $tterm {">}
617         html [lindex [$zs scanLine $i] 1]
618         html {</a>: <em>}
619         html [lindex [$zs scanLine $i] 2]
620         html "</em><br>\n"
621     }
622 }
623
624 proc z39search {setNo piggy tno elements} {
625     global hist
626     global sessionWait
627     global targets
628
629     if {$tno > 0} {
630         set zz z39$tno
631         set host $hist($setNo,$tno,host)
632         set idAuth $hist($setNo,$tno,idAuthentication)
633         set database $hist($setNo,$tno,database)
634         set query $hist($setNo,$tno,query)
635     } else {
636         set zz z39
637         set host $hist($setNo,host)
638         set idAuth $hist($setNo,idAuthentication)
639         set database $hist($setNo,database)
640         set query $hist($setNo,query)
641     }
642     if {[catch [list $zz failback fail-response]]} {
643         ir $zz
644     }
645     if {[catch [list set oldHost [$zz connect]]]} {
646         set oldHost ""
647     }
648     $zz callback ok-response
649     $zz failback fail-response
650     if {$oldHost != $host} {
651         catch [list $zz disconnect]
652
653         set sessionWait 0
654         if {[catch [list $zz connect $host]]} {
655             displayError "Cannot connect to target" $host
656             return 0
657         } elseif {$sessionWait == 0} {
658             if {[catch {zwait sessionWait 300}]} {
659                 $zz disconnect
660                 displayError "Cannot connect to target" $host
661                 return 0
662             }
663             if {$sessionWait != 1} {
664                 displayError "Cannot connect to target" $host
665                 return 0
666             }
667         }
668         $zz idAuthentication $idAuth
669         set sessionWait 0
670         if {[catch {$zz init}]} {
671             displayError "Cannot initialize target" $host
672             $zz disconnect
673             return 0
674         }
675         if {[catch {zwait sessionWait 60}]} {
676             displayError "Cannot initialize target" $host
677             $zz disconnect
678             return 0
679         }
680         if {$sessionWait != "1"} {
681             displayError "Cannot initialize target" $host
682             $zz disconnect
683             return 0
684         }
685         if {![$zz initResult]} {
686             set u [$zz userInformationField]
687             $zz disconnect
688             displayError "Cannot initialize target $host" $u
689             return 0
690         }
691     } else {
692         if {[info exists hist($setNo,hits)] && \
693                 ![catch [list $zz.$setNo smallSetUpperBound 0]]} {
694             return 1
695         }
696         
697     }
698     ir-set $zz.$setNo $zz
699     
700     if {![lindex $targets($host) 5]} {
701         set elements {}
702     }
703     $zz.$setNo smallSetElementSetNames $elements
704     $zz.$setNo mediumSetElementSetNames $elements
705     $zz.$setNo recordElements $elements
706
707     wlog debug "database=$database"
708     eval $zz.$setNo databaseNames $database
709
710     $zz.$setNo preferredRecordSyntax USMARC
711
712     $zz callback [list search-response $zz.$setNo]
713     if {$piggy} {
714         $zz.$setNo largeSetLowerBound 999999
715         $zz.$setNo smallSetUpperBound 0
716         $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
717     } else {
718         $zz.$setNo largeSetLowerBound 2
719         $zz.$setNo smallSetUpperBound 0
720         $zz.$setNo mediumSetPresentNumber 0
721     }
722     set sessionWait 0
723     $zz.$setNo search $query
724
725     if {[catch {zwait sessionWait 600}]} {
726         wlog debug "timeout/cancel in search"
727         displayError "Timeout in search" {}
728         html "</body></html>\n"
729         $zz disconnect
730         return 0
731     }
732         
733     if {$sessionWait == -1} {
734         displayError "Search fail" "Connection closed"
735         html "</body></html>\n"
736         $zz disconnect
737     }
738     if {$sessionWait != 1} {
739         return 0
740     }
741     set hist($setNo,hits) [$zz.$setNo resultCount]
742     return 1
743 }
744
745 proc init-m-response {i} {
746     global zstatus
747     global zleft
748
749     wlog debug "init-m-response"
750
751     set zstatus($i) 1
752     incr zleft -1
753 }
754
755 proc connect-m-response {i} {
756     global zstatus
757     global zleft
758
759     wlog debug "connect-m-response"
760     z39$i callback [list init-m-response $i]
761     if {[catch {z39$i init}]} {
762         set zstatus($i) -1
763         incr zleft -1
764     }
765 }
766
767 proc fail-m-response {i} {
768     global zstatus
769     global zleft
770     
771     wlog debug "fail-m-response"
772     set zstatus($i) -1
773     incr zleft -1
774 }
775
776 proc search-m-response {setNo i} {
777     global zleft
778     global zstatus
779
780     incr zleft -1
781     set zstatus($i) 2
782 }
783
784 proc z39msearch {setNo piggy elements} {
785     global zleft
786     global zstatus
787     global hist
788     global targets
789
790     set not $hist($setNo,0,host)
791
792     for {set i 1} {$i <= $not} {incr i} {
793         set host $hist($setNo,$i,host)
794         if {[catch {z39 failback fail-response}]} {
795             ir z39$i
796         }
797         if {[catch {set oldHost [z39$i connect]}]} {
798             set oldHost ""
799         }
800         if {$oldHost != $host} {
801             catch {z39$i disconnect}
802         }
803         z39$i callback [list connect-m-response $i]
804         z39$i failback [list fail-m-response $i]
805     }
806     set zleft 0
807     for {set i 1} {$i <= $not} {incr i} {
808         set oldHost [z39$i connect]
809         set host $hist($setNo,$i,host)
810         if {$oldHost == $host} {
811             set zstatus($i) 1
812             continue
813         }
814         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
815         html "Connecting to target " $host " <br>\n"
816         set zstatus($i) -1
817         if {![catch {z39$i connect $host}]} {
818             incr zleft
819         } 
820     }
821     while {$zleft > 0} {
822         wlog debug "Waiting for init response"
823         if {[catch {zwait zleft 10}]} {
824             break
825         }
826     }
827     set zleft 0
828     for {set i 1} {$i <= $not} {incr i} {
829         html "host " $hist($setNo,$i,host) ": "
830         if {$zstatus($i) >= 1} {
831             html "ok <br>\n"
832             ir-set z39$i.$setNo z39$i
833             set hist($setNo,$i,offset) 0
834             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
835
836             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
837                 set thisElements {}
838             } else {
839                 set thisElements $elements
840             }
841             z39$i.$setNo smallSetElementSetNames $thisElements
842             z39$i.$setNo mediumSetElementSetNames $thisElements
843             z39$i.$setNo recordElements $thisElements
844
845             z39$i.$setNo preferredRecordSyntax USMARC
846             z39$i callback [list search-m-response $setNo $i]
847
848             if {$piggy} {
849                 z39$i.$setNo largeSetLowerBound 999999
850                 z39$i.$setNo smallSetUpperBound 0
851                 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
852             } else {
853                 z39$i.$setNo largeSetLowerBound 2
854                 z39$i.$setNo smallSetUpperBound 0
855                 z39$i.$setNo mediumSetPresentNumber 0
856             }
857             set zstatus($i) 1
858             wlog debug "search " $hist($setNo,$i,query)
859             z39$i.$setNo search $hist($setNo,$i,query)
860             incr zleft
861         } else {
862             html "fail <br>\n"
863         }
864     }
865     while {$zleft > 0} {
866         wlog debug "Waiting for search response"
867         if {[catch {zwait zleft 30}]} {
868             break
869         }
870     }
871     for {set i 1} {$i <= $not} {incr i} {
872         if {$zstatus($i) != 2} continue
873         set status [z39$i.$setNo responseStatus]
874         if {[lindex $status 0] != "NSD"} {
875             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
876         }
877     }
878 }
879
880 proc z39present {setNo tno setOffset setMax dfunc elements} {
881     global hist
882     global sessionWait
883     global targets
884
885     if {$tno > 0} {
886         set zz z39$tno
887         set host $hist($setNo,$tno,host)
888     } else {
889         set zz z39
890         set host $hist($setNo,host)
891     }
892
893     if {![lindex $targets($host) 5]} {
894         set elements {}
895     }
896
897     $zz.$setNo elementSetNames $elements
898     $zz.$setNo recordElements $elements
899     set toGet [expr 1 + $setMax - $setOffset]
900
901     $zz callback [list search-response $zz.$setNo]
902
903     while {$setMax > 0 && $toGet > 0} {
904         for {set got 0} {$got < $toGet} {incr got} {
905             if {[$zz.$setNo type [expr $setOffset + $got]] == ""} {
906                 break
907             }
908         }
909         if {$got < $toGet} {
910             set sessionWait 0
911             $zz.$setNo present $setOffset $toGet
912             if {[catch {zwait sessionWait 300}]} {
913                 wlog debug "timeout/cancel in present"
914                 $zz disconnect
915                 break
916             }
917             if {$sessionWait == "0"} {
918                 $zz disconnect
919             }
920             if {$sessionWait != "1"} {
921                 break
922             }
923             set got [$zz.$setNo numberOfRecordsReturned]
924             if {$got <= 0} {
925                 break
926             }
927         }
928         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno
929         set setOffset [expr $got + $setOffset]
930         set toGet [expr 1 + $setMax - $setOffset]
931         wflush
932     }
933 }
934
935 proc z39history {} {
936     global nextSetNo
937     global hist
938     global env
939     global sessionId
940     global targets
941
942     if {![info exists nextSetNo]} {
943         return
944     }
945     html "<h2>History</h2><dl><br>\n"
946     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
947         if {$hist($setNo,scan) > 0} continue
948         set host $hist($setNo,host)
949         html {<dt> } [lindex $targets($host) 0]
950         if {[llength [lindex $targets($host) 1]] > 1} {
951             html ": "
952             foreach b $hist($setNo,database) {
953                 html " $b"
954             }
955         }
956         html {. }
957
958         if {[info exists hist($setNo,hits)]} {
959             html { <a href="http:} $env(SCRIPT_NAME)
960             html / $sessionId {/search.egw/} $setNo + 1
961             html + $hist($setNo,maxPresent)
962             html {">Result</a>: } $hist($setNo,hits) { hits.}
963         } else {
964             html {Search failed.}
965         }
966         html "<dd>\n"
967         html { <a href="http:} $env(SCRIPT_NAME)
968         html / $sessionId {/query.egw/} $host + $setNo 
969         html {">Query</a>: }
970         set op {}
971         for {set i 1} {$i <= 3} {incr i} {
972             if {[string length $hist($setNo,form,entry$i)] > 0} {
973                 html " <b>" [join $op " "] "</b> "
974                 html $hist($setNo,form,menu$i) "=" $hist($setNo,form,entry$i)
975                 set op $hist($setNo,form,logic$i)
976             }
977         }
978     }
979     html "</dl>\n"
980 }
981
982 proc displayError {msga msgb} {
983     html "<p><center>\n"
984     html {<img src="/egwgif/noway.gif" alt="Error">}
985     html "<h2>" $msga "</h2>\n"
986     if {$msgb != ""} {
987         html "<h3>" $msgb "</h3>\n"
988     }
989     html "</center><p>\n"
990 }
991
992 proc button-europagate {} {
993     global useIcons
994     if {$useIcons} {
995         html {<img src="/egwgif/button-egw.gif" alt="Europagate" border=0></a>}
996     } else {
997         html {Europagate | }
998     }
999 }
1000
1001 proc button-new-target {more} {
1002     global useIcons
1003     global env
1004     global sessionId
1005
1006     html {<a href="http:} $env(SCRIPT_NAME)
1007     html / $sessionId {/targets.egw}
1008     if {$useIcons} {
1009         html {"><img src="/egwgif/button-new-target.gif" }
1010         html {alt="New Target" border=0></a>}
1011     } else {
1012         html {">New Target</a>}
1013         if {$more} {
1014             html " | \n"
1015         } else {
1016             html "\n"
1017         }
1018     }
1019 }
1020
1021 proc button-view-history {more} {
1022     global useIcons
1023     global env
1024     global sessionId
1025     global nextSetNo
1026
1027     html {<a href="http:} $env(SCRIPT_NAME)
1028     html / $sessionId {/history.egw;}
1029     catch { html "/" $nextSetNo}
1030     if {$useIcons} {
1031         html {"><img src="/egwgif/button-view-history.gif" alt="View History" }
1032         html {border=0></a>}
1033     } else {
1034         html {">View History</a>}
1035         if {$more} {
1036             html " | \n"
1037         } else {
1038             html "\n"
1039         }
1040     }
1041 }
1042
1043 proc button-new-query {more setNo} {
1044     global useIcons
1045     global env
1046     global sessionId
1047     global hist
1048
1049     html {<a href="http:} $env(SCRIPT_NAME)
1050     html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo {">}
1051     if {$useIcons} {
1052         html {<img src="/egwgif/button-new-query.gif" }
1053         html {alt="New Query" border=0></a>}
1054     } else {
1055         html {New Query</a>}
1056         if {$more} {
1057             html " | \n"
1058         } else {
1059             html "\n"
1060         }
1061     }
1062 }
1063
1064 proc button-scan-window {more setNo} {
1065     global useIcons
1066     global env
1067     global sessionId
1068     global hist
1069
1070     html {<a href="http:} $env(SCRIPT_NAME)
1071     html / $sessionId {/search.egw/} $setNo + {scan} {">}
1072     if {$useIcons} {
1073         html {<img src="/egwgif/button-scan-window.gif" }
1074         html {alt="Scan" border=0></a>}
1075     } else {
1076         html {Scan</a>}
1077         if {$more} {
1078             html " | \n"
1079         } else {
1080             html "\n"
1081         }
1082     }
1083 }
1084
1085 proc maintenance {} {
1086     html {<hr>This page is maintained by }
1087     html {<a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.}
1088     html {Last modified 9. january 1996. <br>}
1089     html {<em> This and the following pages are under construction and }
1090     html {will continue to be so until the end of January 1996.</em>}
1091 }