59131ff122de2d5b9cb69a7cb7e32713289f314b
[egate.git] / www / z39util.tcl
1 #
2 # $Id: z39util.tcl,v 1.30 1996/02/12 13:39:41 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     } dispError ] } {
108         html { <a href="http:} $env(SCRIPT_NAME) /
109         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
110         set p 0
111         foreach a $author {
112             if {$p} {
113                 html ", "
114             }
115             html $a
116             set p 1
117         }
118         foreach a $corp {
119             if {$p} {
120                 html ", "
121             }
122             html $a
123             set p 1
124         }
125         foreach a $meet {
126             if {$p} {
127                 html ", "
128             }
129             html $a
130             set p 1
131         }
132         if {$p} {
133             html ": "
134         }
135         set nope 1
136         foreach v $title {
137             html $v
138             set nope 0
139         }
140         if {$nope} {
141             set v [join $cover ""]
142             if {[string length $v] > 40} {
143                 set nope 0
144                 html [string range $v 0 38] "..."
145             } elseif {[string length $v] > 0} {
146                 set nope 0
147                 html $v
148             } else {
149                 html "No Title"
150             }
151         }
152         html {</a> }
153     } else {
154         html { <a href="http:} $env(SCRIPT_NAME) /
155         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
156         html {No Title}
157         html {</a> }
158         html "Error: " $dispError "\n"
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         html "<br>\n"
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 [egw_form entry$i]
436     if {$term != ""} {
437         set field [join [egw_form 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 [egw_form entry$i]]
456         if {[string length $term] > 0} {
457             set field [join [egw_form 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 [egw_form 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     set thisHost [splitHostSpec $host]
509     if {$oldHost != $thisHost} {
510         catch [list $zz disconnect]
511
512         set sessionWait 0
513         if {[catch [list $zz connect $thisHost]]} {
514             displayError "Cannot connect to target" $thisHost
515             return 0
516         } elseif {$sessionWait == 0} {
517             if {[catch {egw_wait sessionWait 300}]} {
518                 $zz disconnect
519                 displayError "Cannot connect to target" $thisHost
520                 return 0
521             }
522             if {$sessionWait != 1} {
523                 displayError "Cannot connect to target" $thisHost
524                 return 0
525             }
526         }
527         $zz idAuthentication $idAuth
528         set sessionWait 0
529         if {[catch {$zz init}]} {
530             displayError "Cannot initialize target" $thisHost
531             $zz disconnect
532             return 0
533         }
534         if {[catch {egw_wait sessionWait 60}]} {
535             displayError "Cannot initialize target" $thisHost
536             $zz disconnect
537             return 0
538         }
539         if {$sessionWait != "1"} {
540             displayError "Cannot initialize target" $thisHost
541             $zz disconnect
542             return 0
543         }
544         if {![$zz initResult]} {
545             set u [$zz userInformationField]
546             $zz disconnect
547             displayError "Cannot initialize target $thisHost" $u
548             return 0
549         }
550     } else {
551         if {$cache && ![catch [list $zs numberOfTermsRequested 5]]} {
552             return 1
553         }
554     }
555     eval $zz databaseNames $database
556
557     ir-scan $zs $zz
558
559     $zs numberOfTermsRequested $scanLines
560     $zs preferredPositionInResponse $scanPos
561
562     $zz callback [list scan-response $zs]
563
564     egw_log debug "scan: ${scanAttr} ${scanTerm}"
565     set sessionWait 0
566     $zs scan "${scanAttr} ${scanTerm}"
567
568     if {[catch {egw_wait sessionWait 60}]} {
569         egw_log debug "timeout/cancel in scan"
570         displayError "Timeout in scan" {}
571         html "</body></html>\n"
572         $zz disconnect
573         return 0
574     }
575     if {$sessionWait == -1} {
576         displayError "Scan fail" "Connection closed"
577         html "</body></html>\n"
578         $zz disconnect
579     }
580     if {$sessionWait != 1} {
581         return 0
582     }
583     return 1
584 }
585
586 proc display-scan {setNo scanNo tno} {
587     global hist
588     global targets
589     global env
590     global sessionId
591
592     if {$tno > 0} {
593         set zz z39$tno
594     } else {
595         set zz z39
596     }
597     set zs $zz.s$scanNo.$setNo
598     set m [$zs numberOfEntriesReturned]
599         
600     if {$m > 0} {
601         set t [lindex [$zs scanLine 0] 1]
602         if {$tno > 0} {
603             set hist($setNo,$tno,[expr $scanNo - 1],scanTerm) $t
604         } else {
605             set hist($setNo,[expr $scanNo - 1],scanTerm) $t
606         }
607         set t [lindex [$zs scanLine [expr $m - 1]] 1]
608         if {$tno > 0} {
609             set hist($setNo,$tno,[expr $scanNo + 1],scanTerm) $t
610         } else {
611             set hist($setNo,[expr $scanNo + 1],scanTerm) $t
612         }
613     }
614     html {<table width=500 border=0><tr>}
615     html {<td align=left><b>Scan term</b>}
616     html {<td align=right><b>Hits</b>}
617     html {<tr>} \n
618
619     for {set i 0} {$i < $m} {incr i} {
620         html {<td align=left>}
621         if {0} {
622             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
623             html {<a href="http:} $env(SCRIPT_NAME)
624             html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo +
625             html $hist($setNo,scan) +  $tterm {">}
626         } else {
627             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
628             html {<a href="http:} $env(SCRIPT_NAME)
629             html / $sessionId {/search.egw/} $setNo +
630             html hyper + $tterm {">}
631         }
632         html [lindex [$zs scanLine $i] 1]
633         html {</a>} 
634         html {<td align=right>}
635         html [lindex [$zs scanLine $i] 2]
636         html {<tr>} \n
637     }
638     html {</table} \n
639 }
640
641 proc z39search {setNo piggy tno elements} {
642     global hist
643     global sessionWait
644     global targets
645
646     if {$tno > 0} {
647         set zz z39$tno
648         set host $hist($setNo,$tno,host)
649         set idAuth $hist($setNo,$tno,idAuthentication)
650         set database $hist($setNo,$tno,database)
651         set query $hist($setNo,$tno,query)
652     } else {
653         set zz z39
654         set host $hist($setNo,host)
655         set idAuth $hist($setNo,idAuthentication)
656         set database $hist($setNo,database)
657         set query $hist($setNo,query)
658     }
659     if {[catch [list $zz failback fail-response]]} {
660         ir $zz
661     }
662     if {[catch [list set oldHost [$zz connect]]]} {
663         set oldHost ""
664     }
665     $zz callback ok-response
666     $zz failback fail-response
667     set thisHost [splitHostSpec $host]
668     if {$oldHost != $thisHost} {
669         catch [list $zz disconnect]
670
671         set sessionWait 0
672         if {[catch [list $zz connect $thisHost]]} {
673             displayError "Cannot connect to target" $thisHost
674             return 0
675         } elseif {$sessionWait == 0} {
676             if {[catch {egw_wait sessionWait 300}]} {
677                 $zz disconnect
678                 displayError "Cannot connect to target" $thisHost
679                 return 0
680             }
681             if {$sessionWait != 1} {
682                 displayError "Cannot connect to target" $thisHost
683                 return 0
684             }
685         }
686         $zz idAuthentication $idAuth
687         set sessionWait 0
688         if {[catch {$zz init}]} {
689             displayError "Cannot initialize target" $thisHost
690             $zz disconnect
691             return 0
692         }
693         if {[catch {egw_wait sessionWait 60}]} {
694             displayError "Cannot initialize target" $thisHost
695             $zz disconnect
696             return 0
697         }
698         if {$sessionWait != "1"} {
699             displayError "Cannot initialize target" $thisHost
700             $zz disconnect
701             return 0
702         }
703         if {![$zz initResult]} {
704             set u [$zz userInformationField]
705             $zz disconnect
706             displayError "Cannot initialize target $thisHost" $u
707             return 0
708         }
709     } else {
710         if {[info exists hist($setNo,hits)] && \
711                 ![catch [list $zz.$setNo smallSetUpperBound 0]]} {
712             return 1
713         }
714         
715     }
716     ir-set $zz.$setNo $zz
717     
718     if {![lindex $targets($host) 5]} {
719         set elements {}
720     }
721     $zz.$setNo smallSetElementSetNames $elements
722     $zz.$setNo mediumSetElementSetNames $elements
723     $zz.$setNo recordElements $elements
724
725     egw_log debug "database=$database"
726     eval $zz.$setNo databaseNames $database
727
728     $zz.$setNo preferredRecordSyntax USMARC
729
730     $zz callback [list search-response $zz.$setNo]
731     if {$piggy} {
732         $zz.$setNo largeSetLowerBound 999999
733         $zz.$setNo smallSetUpperBound 0
734         $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
735     } else {
736         $zz.$setNo largeSetLowerBound 2
737         $zz.$setNo smallSetUpperBound 0
738         $zz.$setNo mediumSetPresentNumber 0
739     }
740     set sessionWait 0
741     egw_log debug "search: $query"
742     $zz.$setNo search $query
743
744     if {[catch {egw_wait sessionWait 600}]} {
745         egw_log debug "timeout/cancel in search"
746         displayError "Timeout in search" {}
747         html "</body></html>\n"
748         $zz disconnect
749         return 0
750     }
751         
752     if {$sessionWait == -1} {
753         displayError "Search fail" "Connection closed"
754         html "</body></html>\n"
755         $zz disconnect
756     }
757     if {$sessionWait != 1} {
758         return 0
759     }
760     set hist($setNo,hits) [$zz.$setNo resultCount]
761     return 1
762 }
763
764 proc init-m-response {i} {
765     global zstatus
766     global zleft
767
768     egw_log debug "init-m-response"
769
770     set zstatus($i) 1
771     incr zleft -1
772 }
773
774 proc connect-m-response {i} {
775     global zstatus
776     global zleft
777
778     egw_log debug "connect-m-response"
779     z39$i callback [list init-m-response $i]
780     if {[catch {z39$i init}]} {
781         set zstatus($i) -1
782         incr zleft -1
783     }
784 }
785
786 proc fail-m-response {i} {
787     global zstatus
788     global zleft
789     
790     egw_log debug "fail-m-response"
791     set zstatus($i) -1
792     incr zleft -1
793 }
794
795 proc search-m-response {setNo i start number} {
796     global zleft
797     global zstatus
798     global hist
799
800     egw_log debug "search-m-response"
801     set status [z39$i.$setNo responseStatus]
802     egw_log debug "search-m-response1"
803     if {[lindex $status 0] != "DBOSD"} {
804         egw_log debug "search-m-response2"
805         incr zleft -1
806         set zstatus($i) 2
807         return
808     }
809     set nor [z39$i.$setNo numberOfRecordsReturned]
810     egw_log debug "search-m-response3"
811     set hist($setNo,$i,offset) [expr $start + $nor -1]
812     if {[expr $nor + $start] >= [z39$i.$setNo resultCount]} {
813         egw_log debug "search-m-response4"
814         incr zleft -1
815         set zstatus($i) 2
816         return
817     }
818     egw_log debug "search-m-response5"
819     if {$nor >= $number} {
820         egw_log debug "search-m-response6"
821         incr zleft -1
822         set zstatus($i) 2
823         return
824     }
825     egw_log debug "search-m-response7"
826     set start [expr $start + $nor]
827     set number [expr $number - $nor]
828     if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
829         set number [expr [z39$i.$setNo resultCount] - $start + 1]
830     }
831     z39$i callback [list search-m-response $setNo $i $start $number]
832     egw_log debug "mpresent start=$number number=$number"
833     z39$i.$setNo present $start $number
834 }
835
836 proc z39msearch {setNo elements start number cache} {
837     global zleft
838     global zstatus
839     global hist
840     global targets
841
842     set not $hist($setNo,0,host)
843
844     for {set i 1} {$i <= $not} {incr i} {
845         set host $hist($setNo,$i,host)
846         if {[catch [list z39$i failback fail-m-response $i]]} {
847             ir z39$i
848         }
849         set oldHost [z39$i connect]
850         set thisHost [splitHostSpec $host]
851         if {$oldHost != $thisHost} {
852             catch {z39$i disconnect}
853         }
854         z39$i callback [list connect-m-response $i]
855         z39$i failback [list fail-m-response $i]
856     }
857     set zleft 0
858     for {set i 1} {$i <= $not} {incr i} {
859         set oldHost [z39$i connect]
860         set host $hist($setNo,$i,host)
861         set thisHost [splitHostSpec $host]
862         if {$oldHost == $thisHost} {
863             continue
864         }
865         egw_log debug "old=$oldHost this=$thisHost"
866         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
867         html "Connecting to target " $thisHost " <br>\n"
868         set zstatus($i) -1
869         if {![catch {z39$i connect $thisHost}]} {
870             incr zleft
871         } 
872     }
873     while {$zleft > 0} {
874         egw_log debug "Waiting for init response"
875         if {[catch {egw_wait zleft 20}]} {
876             break
877         }
878     }
879     set zleft 0
880     for {set i 1} {$i <= $not} {incr i} {
881         html "host " [splitHostSpec $hist($setNo,$i,host)] ": "
882         egw_log debug "i=$i zstatus=$zstatus($i)"
883         if {$zstatus($i) < 1} {
884             html "fail<br>\n"
885             continue
886         }
887         if {[catch [list z39$i.$setNo preferredRecordSyntax USMARC]]} {
888             html "ok<br>\n"
889             ir-set z39$i.$setNo z39$i
890             set hist($setNo,$i,offset) 0
891             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
892
893             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
894                 set thisElements {}
895             } else {
896                 set thisElements $elements
897             }
898             z39$i.$setNo smallSetElementSetNames $thisElements
899             z39$i.$setNo mediumSetElementSetNames $thisElements
900             z39$i.$setNo elementSetNames $thisElements
901             z39$i.$setNo recordElements $thisElements
902
903             z39$i.$setNo preferredRecordSyntax USMARC
904             z39$i callback [list search-m-response $setNo $i $start $number]
905
906             if {$start == 1} {
907                 z39$i.$setNo largeSetLowerBound 999999
908                 z39$i.$setNo smallSetUpperBound 0
909                 z39$i.$setNo mediumSetPresentNumber $number
910             } else {
911                 z39$i.$setNo largeSetLowerBound 2
912                 z39$i.$setNo smallSetUpperBound 0
913                 z39$i.$setNo mediumSetPresentNumber 0
914             }
915             set zstatus($i) 1
916             incr zleft
917             egw_log debug "setNo=$setNo msearch " $hist($setNo,$i,query)
918             z39$i.$setNo search $hist($setNo,$i,query)
919         } elseif {[z39$i.$setNo resultCount] >= $start} {
920             if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
921                 set tnumber [expr [z39$i.$setNo resultCount] - $start + 1]
922             } else {
923                 set tnumber $number
924             }
925             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
926                 set thisElements {}
927             } else {
928                 set thisElements $elements
929             }
930             z39$i.$setNo smallSetElementSetNames $thisElements
931             z39$i.$setNo mediumSetElementSetNames $thisElements
932             z39$i.$setNo elementSetNames $thisElements
933             z39$i.$setNo recordElements $thisElements
934
935             for {set n 0} {$n < $tnumber} {incr n} {
936                 if {[z39$i.$setNo type [expr $start + $n]] == ""} {
937                     if {$n > 0} {
938                         egw_log debug "failed on $n"
939                     }
940                     break
941                 }
942             }
943             if {$n == $tnumber} {
944                 html "cached<br>\n"
945                 continue
946             }
947             
948             html "present<br>\n"
949             z39$i.$setNo preferredRecordSyntax USMARC
950             z39$i callback [list search-m-response $setNo $i $start $tnumber]
951             incr zleft
952             egw_log debug "mpresent start=$start number=$tnumber"
953             z39$i.$setNo present $start $tnumber
954         } else {
955             html "ok<br>\n"
956         }
957     }
958     while {$zleft > 0} {
959         egw_log debug "Waiting for search/present response"
960         if {[catch {egw_wait zleft 60}]} {
961             break
962         }
963     }
964     for {set i 1} {$i <= $not} {incr i} {
965         if {$zstatus($i) != 2} continue
966         set status [z39$i.$setNo responseStatus]
967         if {0 && [lindex $status 0] != "NSD"} {
968             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
969         }
970     }
971 }
972
973 proc z39present {setNo tno setOffset setMax dfunc elements} {
974     global hist
975     global sessionWait
976     global targets
977
978     if {$tno > 0} {
979         set zz z39$tno
980         set host $hist($setNo,$tno,host)
981     } else {
982         set zz z39
983         set host $hist($setNo,host)
984     }
985
986     if {![lindex $targets($host) 5]} {
987         set elements {}
988     }
989
990     $zz.$setNo elementSetNames $elements
991     $zz.$setNo recordElements $elements
992     set toGet [expr 1 + $setMax - $setOffset]
993
994     $zz callback [list search-response $zz.$setNo]
995
996     while {$setMax > 0 && $toGet > 0} {
997         for {set got 0} {$got < $toGet} {incr got} {
998             if {[$zz.$setNo type [expr $setOffset + $got]] == ""} {
999                 break
1000             }
1001         }
1002         if {$got < $toGet} {
1003             set sessionWait 0
1004             $zz.$setNo present $setOffset $toGet
1005             if {[catch {egw_wait sessionWait 300}]} {
1006                 egw_log debug "timeout/cancel in present"
1007                 $zz disconnect
1008                 break
1009             }
1010             if {$sessionWait == "0"} {
1011                 $zz disconnect
1012             }
1013             if {$sessionWait != "1"} {
1014                 break
1015             }
1016             set got [$zz.$setNo numberOfRecordsReturned]
1017             if {$got <= 0} {
1018                 break
1019             }
1020         }
1021         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno
1022         set setOffset [expr $got + $setOffset]
1023         set toGet [expr 1 + $setMax - $setOffset]
1024         egw_flush
1025     }
1026 }
1027
1028 proc z39history {} {
1029     global nextSetNo
1030     global hist
1031     global env
1032     global sessionId
1033     global targets
1034     global html3
1035
1036     if {![info exists nextSetNo]} {
1037         return
1038     }
1039     html "<h2>History</h2><br>\n"
1040     if {$html3} {
1041         html {<table width=500 border=1><tr>}
1042         html {<td align=center><b>Target</b>}
1043         html {<td align=center><b>Database</b>}
1044         html {<td align=center><b>Hits</b>}
1045         html {<td align=center><b>Query</b>}
1046         html {<tr>} "\n"
1047     } else {
1048         html {<dl>} "\n"
1049     }
1050     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
1051         if {$hist($setNo,scan) > 0} continue
1052         set host $hist($setNo,host)
1053         if {$html3} {
1054             html {<td align=left>}
1055         } else {
1056             html {<dt> }
1057         }
1058         html [lindex $targets($host) 0]
1059         if {$html3} {
1060             html {<td align=left>} [join $hist($setNo,database)]
1061         } else {
1062             if {[llength [lindex $targets($host) 1]] > 1} {
1063                 html ": "
1064                 foreach b $hist($setNo,database) {
1065                     html " $b"
1066                 }
1067             }
1068             html {. }
1069         }
1070         if {$html3} {
1071             html {<td align=right>}
1072         }
1073         if {[info exists hist($setNo,hits)]} {
1074             html { <a href="http:} $env(SCRIPT_NAME)
1075             html / $sessionId {/search.egw/} $setNo + 1
1076             html + $hist($setNo,maxPresent)
1077             if {1} {
1078                 html {">} $hist($setNo,hits) {</a>}
1079             } else {
1080                 html {">Result</a>: } $hist($setNo,hits) { hits.}
1081             }
1082         } else {
1083             if {$html3} {
1084                 html {Failed}
1085             } else {
1086                 html {Search failed.}
1087             }
1088         }
1089         if {$html3} {
1090             html {<td align=left>}
1091         } else {
1092             html "<dd>\n"
1093         }
1094         html { <a href="http:} $env(SCRIPT_NAME)
1095         html / $sessionId {/query.egw/} $host + $setNo
1096         if {$html3} {
1097             html {">}
1098         } else {
1099             html {">Query</a>: }
1100         }
1101         set op {}
1102         for {set i 1} {$i <= 3} {incr i} {
1103             if {[string length $hist($setNo,form,entry$i)] > 0} {
1104                 html " <b>" [join $op " "] "</b> "
1105                 html [join $hist($setNo,form,menu$i)] "=" 
1106                 html $hist($setNo,form,entry$i)
1107                 set op $hist($setNo,form,logic$i)
1108             }
1109         }
1110         if {$html3} {
1111             html {</a><tr>} "\n"
1112         }
1113     }
1114     if {$html3} {
1115         html {</table><p>}
1116     } else {
1117         html {</dl>}
1118     }
1119     html "\n"
1120 }
1121
1122 proc displayError {msga msgb} {
1123     html "<p><center>\n"
1124     html {<img src="/egwgif/noway.gif" alt="Error">}
1125     html "<h2>" $msga "</h2>\n"
1126     if {$msgb != ""} {
1127         html "<h3>" $msgb "</h3>\n"
1128     }
1129     html "</center><p>\n"
1130 }
1131
1132 proc button-europagate {} {
1133     global useIcons
1134     html {<a href="http://europagate.dtv.dk/">}
1135     if {$useIcons} {
1136         html {<img src="/egwgif/button-egw.gif" alt="Europagate" border=0></a>}
1137     } else {
1138         html {Europagate</a> | }
1139     }
1140 }
1141
1142 proc button-define-target {more} {
1143     global useIcons
1144     global env
1145     global sessionId
1146
1147     html {<a href="http:} $env(SCRIPT_NAME)
1148     html / $sessionId {/tform.egw}
1149     if {$useIcons} {
1150         html {"><img src="/egwgif/button-define-target.gif" }
1151         html {alt="Define Target" border=0></a>}
1152     } else {
1153         html {">Define Target</a>}
1154         if {$more} {
1155             html " | \n"
1156         } else {
1157             html "\n"
1158         }
1159     }
1160 }
1161
1162 proc button-new-target {more} {
1163     global useIcons
1164     global env
1165     global sessionId
1166     global mMode
1167
1168     html {<a href="http:} $env(SCRIPT_NAME)
1169     html / $sessionId 
1170     if {$mMode} {
1171         html {/mtargets.egw}
1172     } else {
1173         html {/targets.egw}
1174     }
1175     if {$useIcons} {
1176         html {"><img src="/egwgif/button-new-target.gif" }
1177         html {alt="New Target" border=0></a>}
1178     } else {
1179         html {">New Target</a>}
1180         if {$more} {
1181             html " | \n"
1182         } else {
1183             html "\n"
1184         }
1185     }
1186 }
1187
1188 proc button-view-history {more} {
1189     global useIcons
1190     global env
1191     global sessionId
1192     global nextSetNo
1193
1194     html {<a href="http:} $env(SCRIPT_NAME)
1195     html / $sessionId {/history.egw;}
1196     catch { html "/" $nextSetNo}
1197     if {$useIcons} {
1198         html {"><img src="/egwgif/button-view-history.gif" alt="View History" }
1199         html {border=0></a>}
1200     } else {
1201         html {">View History</a>}
1202         if {$more} {
1203             html " | \n"
1204         } else {
1205             html "\n"
1206         }
1207     }
1208 }
1209
1210 proc button-new-query {more setNo} {
1211     global useIcons
1212     global env
1213     global sessionId
1214     global hist
1215     global mMode
1216
1217     html {<a href="http:} $env(SCRIPT_NAME)
1218     html / $sessionId 
1219     if {$mMode} {
1220         html {/mquery.egw/} $setNo
1221     } else {
1222         html {/query.egw/} $hist($setNo,host) + $setNo
1223     }
1224     html {">}
1225     if {$useIcons} {
1226         html {<img src="/egwgif/button-new-query.gif" }
1227         html {alt="New Query" border=0></a>}
1228     } else {
1229         html {New Query</a>}
1230         if {$more} {
1231             html " | \n"
1232         } else {
1233             html "\n"
1234         }
1235     }
1236 }
1237
1238 proc button-scan-window {more setNo} {
1239     global useIcons
1240     global env
1241     global sessionId
1242     global hist
1243
1244     html {<a href="http:} $env(SCRIPT_NAME)
1245     html / $sessionId {/search.egw/} $setNo + {scan} {">}
1246     if {$useIcons} {
1247         html {<img src="/egwgif/button-scan-window.gif" }
1248         html {alt="Scan" border=0></a>}
1249     } else {
1250         html {Scan</a>}
1251         if {$more} {
1252             html " | \n"
1253         } else {
1254             html "\n"
1255         }
1256     }
1257 }
1258
1259 proc maintenance {} {
1260     html {<hr>This page is maintained by }
1261     html {<a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.}
1262     html {Last modified 29. january 1996. <br>}
1263     html {<em> This and the following pages are under construction and }
1264     html {will continue to be so until the end of January 1996.</em>}
1265 }
1266
1267 proc splitHostSpec {host} {
1268     set i [string last . $host]
1269     if {$i > 1} {
1270         incr i -1
1271         return [string range $host 0 $i]
1272     }
1273     return $host
1274 }
1275
1276 proc mergeHostSpec {host databases} {
1277     return ${host}.[join $databases -]
1278 }