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