Bug fix: didn't use correct database(s) when 'all' checkbox was selected.
[egate.git] / www / z39util.tcl
1 #
2 # $Id: z39util.tcl,v 1.11 1995/11/14 16:01:52 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 ok-response {} {
47     global sessionWait
48     set sessionWait 1
49 }
50
51 proc fail-response {} {
52     global sessionWait
53     set sessionWait -1
54 }
55
56 proc display-brief {zset no tno} {
57     global env
58     global setNo
59     global sessionId
60
61     set type [$zset type $no]
62     if {$type == "SD"} {
63         set err [lindex [$zset diag $no] 1]
64         set add [lindex [$zset diag $no] 2]
65         if {$add != {}} {
66             set add " :${add}"
67         }
68         html "${no} Error ${err}${add} <br>\n"
69         return
70     }
71     if {$type != "DB"} {
72         return
73     }
74     html "${no}"
75     set rtype [$zset recordType $no]
76     if {$rtype == "SUTRS"} {
77         html [join [$zset getSutrs $no]]
78         html "<br>\n"
79         return
80     } 
81     if {![catch {
82         set title [lindex [$zset getMarc $no field 245 * a] 0]
83         set year [lindex [$zset getMarc $no field 260 * c] 0]
84     } ] } {
85         html {<a href="http:} $env(SCRIPT_NAME) /
86         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full 
87         html {"> } $title {</a>} " <i> ${year} </i>"
88     }
89     html "<br>\n"
90 }
91
92 proc display-raw {zset no tno} {
93     set type [$zset type $no]
94     if {$type == "SD"} {
95         set err [lindex [$zset diag $no] 1]
96         set add [lindex [$zset diag $no] 2]
97         if {$add != {}} {
98             set add " :${add}"
99         }
100         html "<h3>${no}</h3>\n"
101         html "Error ${err}${add} <br>\n"
102         return
103     }
104     if {$type != "DB"} {
105         return
106     }
107     set rtype [$zset recordType $no]
108     if {$rtype == "SUTRS"} {
109         html [join [$zset getSutrs $no]] "<br>\n"
110         return
111     } 
112     if {[catch {set r [$zset getMarc $no line * * *]}]} {
113         html "Unknown record type: $rtype <br>\n"
114         return
115     }
116     foreach line $r {
117         set tag [lindex $line 0]
118         set indicator [lindex $line 1]
119         set fields [lindex $line 2]
120         set l [string length $indicator]
121         html "$tag "
122         if {$l > 0} {
123             for {set i 0} {$i < $l} {incr i} {
124                 if {[string index $indicator $i] == " "} {
125                     html "-"
126                 } else {
127                     html [string index $tag $i]
128                 }
129             }
130         }
131         foreach field $fields {
132             set id [lindex $field 0]
133             set data [lindex $field 1]
134             if {$id != ""} {
135                 html " <b>\$$id</b> "
136             }
137             html $data
138         }
139         htmlr {<br>}
140     }
141 }
142
143 proc put-marc-contents {cc} {
144     set ref ""
145     if {[string first :// $cc] > 0} {
146         foreach urltype {gopher http ftp mailto} {
147             if {[string first ${urltype}:// $cc] == 0} {
148                 set ref $urltype
149                 break
150             }
151         }
152     } 
153     if {$ref != ""} {
154         html {<a href="}
155     }
156     html $cc
157     if {$ref != ""} {
158         html {">} $urltype { reference</a>}
159     }
160 }
161
162 proc dl-marc-field {zset no tag id la lb sep} {
163     set n 0
164     set c [$zset getMarc $no field $tag * $id]
165     set len [llength $c]
166     if {$len == 0} {
167         return 0
168     }
169     if {$len > 1 && "x$lb" != "x"} {
170         html "<dt><b>$lb</b>\n<dd>"
171     } else {
172         html "<dt><b>$la</b>\n<dd>"
173     }
174     foreach cc $c {
175         if {$n > 0} {
176             html $sep
177         }
178         put-marc-contents $cc
179         incr n
180     }
181     return $n
182 }
183
184 proc dd-marc-field {zset no tag id start stop} {
185     set n 0
186     set c [$zset getMarc $no field $tag * $id]
187     set len [llength $c]
188     if {$len == 0} {
189         return 0
190     }
191     foreach cc $c {
192         html $start
193         put-marc-contents $cc
194         html $stop
195         incr n
196     }
197     return $n
198 }
199
200 proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
201     set n 0
202     set lines [$zset getMarc $no line $tag * *]
203     foreach line $lines {
204         foreach field [lindex $line 2] {
205             if {$n == 0} {
206                 html "<dt><b>$lead</b>"
207                 html "\n<dd>"
208             }
209             set id [lindex $field 0]
210             if {$id == $startid} {
211                 if {$n > 0} {
212                     html $stop
213                 }
214                 html $start
215                 incr n
216                 html [lindex $field 1]
217             } else {
218                 html $sep
219                 html [lindex $field 1]
220             }
221         }
222     }
223     if {$n > 0} {
224         html $stop
225     }
226 }
227
228 proc display-full {zset no tno} {
229     set type [$zset type $no]
230     if {$type == "SD"} {
231         set err [lindex [$zset diag $no] 1]
232         set add [lindex [$zset diag $no] 2]
233         if {$add != {}} {
234             set add " :${add}"
235         }
236         html "Error ${err}${add} <br>\n"
237         return
238     }
239     if {$type != "DB"} {
240         return
241     }
242     set rtype [$zset recordType $no]
243     if {$rtype == "SUTRS"} {
244         html [join [$zset getSutrs $no]] "<br>\n"
245         return
246     } 
247     if {[catch {set r [$zset getMarc $no line * * *]}]} {
248         html "Unknown record type: $rtype <br>\n"
249         return
250     }
251     html "<dl>\n"
252     set n [dl-marc-field $zset $no 700 a "Author" "Authors" "<br>\n"]
253     if {$n == 0} {
254         set n [dl-marc-field $zset $no 100 a "Author" "Authors" "<br>\n"]
255     }
256     set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
257     if {$n == 0} {
258         set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
259     }
260     set n [dl-marc-field $zset $no 245 {a} "Title" {} " "]
261     if {$n > 0} {
262         dd-marc-field $zset $no 245 b "<em>" "</em>"
263         dd-marc-field $zset $no 245 c " " ""
264     } else {
265         dl-marc-field $zset $no 245 {[ab]} "Title" {} " "
266     }
267     dl-marc-field $zset $no 520 a "Abstract" {} ", "
268     dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", "
269     dl-marc-field $zset $no 650 * "Subject" {} ", "
270     dl-marc-field $zset $no 260 * "Publisher" {} " "
271     dl-marc-field $zset $no 300 * "Physical Description" {} " "
272
273     dl-marc-field-rec $zset $no 500 "Notes" "" "<br>\n" "a" ", "
274
275     dl-marc-field-rec $zset $no 510 "References" "" "<br>\n" "a" ", "
276
277     dl-marc-field-rec $zset $no 511 "Participant note" "" "<br>\n" "a" ", "
278
279     dl-marc-field $zset $no 513 a "Report type" {} ", "
280     dl-marc-field $zset $no 513 b "Period covered" {} ", "
281     dl-marc-field-rec $zset $no 515 "Numbering notes" "" "<br>\n" "a" ", "
282     dl-marc-field-rec $zset $no 516 "Data notes" "" "<br>\n" "a" ", "
283     dl-marc-field-rec $zset $no 518 "Date/time notes" "" "<br>\n" "a" ", "
284
285     dl-marc-field $zset $no 350 a "Price" {} ", "
286     dl-marc-field $zset $no 362 a "Dates of publication" {} ", "
287     dl-marc-field $zset $no 850 a "Holdings" {} ", "
288
289     dl-marc-field-rec $zset $no 270 "Contact name" "" "<br>\n" p ", "
290     if {0} {
291         set n [dl-marc-field $zset $no 270 p "Contact name" {} ", "]
292         if {$n > 0} {
293             html "\n<dl>\n"
294             
295             if {0} {
296                 dl-marc-field $zset $no 270 a "Street" {} ", "
297                 dl-marc-field $zset $no 270 b "City" {} ", "
298                 dl-marc-field $zset $no 270 c "State" {} ", "
299                 dl-marc-field $zset $no 270 e "Zip code" {} ", "
300                 dl-marc-field $zset $no 270 d "Country" {} ", "
301                 dl-marc-field $zset $no 270 m "Network address" {} ", "
302                 dl-marc-field $zset $no 301 a "Service hours" {} ", "
303                 dl-marc-field $zset $no 270 k "Phone" {} ", "
304                 dl-marc-field $zset $no 270 l "Fax" {} ", "
305             } else {
306                 dl-marc-field $zset $no 270 {[abcedmakl]} "Address" {} "<br>\n"
307             }
308             
309             html "\n</dl>\n"
310         }
311     }
312     dl-marc-field $zset $no 010 a "LC control number" {} ", "
313     dl-marc-field $zset $no 010 b "NUCMC control number" {} ", "
314     dl-marc-field $zset $no 020 a "ISBN" {} ", "
315     dl-marc-field $zset $no 022 a "ISSN" {} ", "
316     set url [$zset getMarc $no field 856 * u]
317     set sp [$zset getMarc $no field 856 * 3]
318     if {"x$url" != "x"} {
319         html "<dt><b>URL</b>\n"
320         if {"x$sp" == "x"} {
321             set sp reference
322         }
323         html {<dd><a href="} $url {">} [join $sp] "</a>\n"
324     }
325     dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "<br>\n"
326     dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "<br>\n"
327     dl-marc-field $zset $no 537 * "Source of data" {} "<br>\n"
328     dl-marc-field $zset $no 538 * "System details" {} "<br>\n"
329     dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "<br>\n"
330     dl-marc-field $zset $no 001 * "Local control number" {} ", "
331     html "</dl>\n"
332 }
333
334
335 proc display-rec {from to dfunc tno} {
336     global setNo
337
338     if {$tno > 0} {
339         while {$from <= $to} { 
340             eval "$dfunc z39${tno}.${setNo} $from $tno"
341             incr from
342         }
343     } else {
344         while {$from <= $to} { 
345             eval "$dfunc z39.${setNo} $from 0"
346             incr from
347         }
348     }
349 }
350
351 proc build-query {t} {
352     global targets
353
354     set op {}
355     set q {}
356     for {set i 1} {$i < 4} {incr i} {
357         set term [wform entry$i]
358         if {$term != ""} {
359             set field [wform menu$i]
360             foreach x [lindex $targets($t) 2] {
361                 if {[lindex $x 0] == $field} {
362                     set attr [lindex $x 1]
363                 }
364             }
365             switch $op {
366             And
367                 { set q "@and $q ${attr} ${term}" }
368             Or
369                 { set q "@or $q ${attr} ${term}" }
370             {And not}
371                 { set q "@not $q ${attr} ${term}" }
372             {}
373                 { set q "${attr} ${term}" }
374             }
375             set op [wform logic$i]
376         }
377     }
378     return $q
379 }
380
381 proc z39search {setNo piggy tno elements} {
382     global hist
383     global sessionWait
384     global targets
385
386     if {$tno > 0} {
387         set zz z39$tno
388         set host $hist($setNo,$tno,host)
389         set idAuth $hist($setNo,$tno,idAuthentication)
390         set database $hist($setNo,$tno,database)
391         set query $hist($setNo,$tno,query)
392     } else {
393         set zz z39
394         set host $hist($setNo,host)
395         set idAuth $hist($setNo,idAuthentication)
396         set database $hist($setNo,database)
397         set query $hist($setNo,query)
398     }
399     if {[catch [list $zz failback fail-response]]} {
400         ir $zz
401     }
402     if {[catch [list set oldHost [$zz connect]]]} {
403         set oldHost ""
404     }
405     $zz callback ok-response
406     $zz failback fail-response
407     if {$oldHost != $host} {
408         catch [list $zz disconnect]
409
410         set sessionWait 0
411         if {[catch [list $zz connect $host]]} {
412             displayError "Cannot connect to target" $host
413             return 0
414         } elseif {$sessionWait == 0} {
415             if {[catch {zwait sessionWait 300}]} {
416                 $zz disconnect
417                 displayError "Cannot connect to target" $host
418                 return 0
419             }
420             if {$sessionWait != 1} {
421                 displayError "Cannot connect to target" $host
422                 return 0
423             }
424         }
425         $zz idAuthentication $idAuth
426         set sessionWait 0
427         if {[catch {$zz init}]} {
428             displayError "Cannot initialize target" $host
429             $zz disconnect
430             return 0
431         }
432         if {[catch {zwait sessionWait 60}]} {
433             displayError "Cannot initialize target" $host
434             $zz disconnect
435             return 0
436         }
437         if {$sessionWait != "1"} {
438             displayError "Cannot initialize target" $host
439             $zz disconnect
440             return 0
441         }
442         if {![$zz initResult]} {
443             set u [$zz userInformationField]
444             $zz disconnect
445             displayError "Cannot initialize target $host" $u
446             return 0
447         }
448     } else {
449         if {![catch [list $zz.$setNo smallSetUpperBound 0]]} {
450             return 1
451         }
452     }
453     ir-set $zz.$setNo $zz
454     
455     if {![lindex $targets($host) 5]} {
456         set elements {}
457     }
458     $zz.$setNo smallSetElementSetNames $elements
459     $zz.$setNo mediumSetElementSetNames $elements
460     $zz.$setNo recordElements $elements
461
462     wlog debug "database=$database"
463     eval $zz.$setNo databaseNames $database
464
465     $zz.$setNo preferredRecordSyntax USMARC
466
467     $zz callback [list search-response $zz.$setNo]
468     if {$piggy} {
469         $zz.$setNo largeSetLowerBound 999999
470         $zz.$setNo smallSetUpperBound 0
471         $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
472     } else {
473         $zz.$setNo largeSetLowerBound 2
474         $zz.$setNo smallSetUpperBound 0
475         $zz.$setNo mediumSetPresentNumber 0
476     }
477     set sessionWait 0
478     $zz.$setNo search $query
479
480     if {[catch {zwait sessionWait 600}]} {
481         wlog debug "timeout/cancel in search"
482         displayError "Timeout in search" {}
483         html "</body></html>\n"
484         $zz disconnect
485         return 0
486     }
487         
488     if {$sessionWait == -1} {
489         displayError "Search fail" "Connection closed"
490         html "</body></html>\n"
491         $zz disconnect
492     }
493     if {$sessionWait != 1} {
494         return 0
495     }
496     set hist($setNo,hits) [$zz.$setNo resultCount]
497     return 1
498 }
499
500 proc init-m-response {i} {
501     global zstatus
502     global zleft
503
504     wlog debug "init-m-response"
505
506     set zstatus($i) 1
507     incr zleft -1
508 }
509
510 proc connect-m-response {i} {
511     global zstatus
512     global zleft
513
514     wlog debug "connect-m-response"
515     z39$i callback [list init-m-response $i]
516     if {[catch {z39$i init}]} {
517         set zstatus($i) -1
518         incr zleft -1
519     }
520 }
521
522 proc fail-m-response {i} {
523     global zstatus
524     global zleft
525     
526     wlog debug "fail-m-response"
527     set zstatus($i) -1
528     incr zleft -1
529 }
530
531 proc search-m-response {setNo i} {
532     global zleft
533     global zstatus
534
535     incr zleft -1
536     set zstatus($i) 2
537 }
538
539 proc z39msearch {setNo piggy elements} {
540     global zleft
541     global zstatus
542     global hist
543     global targets
544
545     set not $hist($setNo,0,host)
546
547     for {set i 1} {$i <= $not} {incr i} {
548         set host $hist($setNo,$i,host)
549         if {[catch {z39 failback fail-response}]} {
550             ir z39$i
551         }
552         if {[catch {set oldHost [z39$i connect]}]} {
553             set oldHost ""
554         }
555         if {$oldHost != $host} {
556             catch {z39$i disconnect}
557         }
558         z39$i callback [list connect-m-response $i]
559         z39$i failback [list fail-m-response $i]
560     }
561     set zleft 0
562     for {set i 1} {$i <= $not} {incr i} {
563         set oldHost [z39$i connect]
564         set host $hist($setNo,$i,host)
565         if {$oldHost == $host} {
566             set zstatus($i) 1
567             continue
568         }
569         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
570         html "Connecting to target " $host " <br>\n"
571         set zstatus($i) -1
572         if {![catch {z39$i connect $host}]} {
573             incr zleft
574         } 
575     }
576     while {$zleft > 0} {
577         wlog debug "Waiting for init response"
578         if {[catch {zwait zleft 10}]} {
579             break
580         }
581     }
582     set zleft 0
583     for {set i 1} {$i <= $not} {incr i} {
584         html "host " $hist($setNo,$i,host) ": "
585         if {$zstatus($i) >= 1} {
586             html "ok <br>\n"
587             ir-set z39$i.$setNo z39$i
588             set hist($setNo,$i,offset) 0
589             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
590
591             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
592                 set thisElements {}
593             } else {
594                 set thisElements $elements
595             }
596             z39$i.$setNo smallSetElementSetNames $thisElements
597             z39$i.$setNo mediumSetElementSetNames $thisElements
598             z39$i.$setNo recordElements $thisElements
599
600             z39$i.$setNo preferredRecordSyntax USMARC
601             z39$i callback [list search-m-response $setNo $i]
602
603             if {$piggy} {
604                 z39$i.$setNo largeSetLowerBound 999999
605                 z39$i.$setNo smallSetUpperBound 0
606                 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
607             } else {
608                 z39$i.$setNo largeSetLowerBound 2
609                 z39$i.$setNo smallSetUpperBound 0
610                 z39$i.$setNo mediumSetPresentNumber 0
611             }
612             set zstatus($i) 1
613             wlog debug "search " $hist($setNo,$i,query)
614             z39$i.$setNo search $hist($setNo,$i,query)
615             incr zleft
616         } else {
617             html "fail <br>\n"
618         }
619     }
620     while {$zleft > 0} {
621         wlog debug "Waiting for search response"
622         if {[catch {zwait zleft 30}]} {
623             break
624         }
625     }
626     for {set i 1} {$i <= $not} {incr i} {
627         if {$zstatus($i) != 2} continue
628         set status [z39$i.$setNo responseStatus]
629         if {[lindex $status 0] != "NSD"} {
630             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
631         }
632     }
633 }
634
635 proc z39present {setNo tno setOffset setMax dfunc elements} {
636     global hist
637     global sessionWait
638     global targets
639
640     if {$tno > 0} {
641         set zz z39$tno
642         set host $hist($setNo,$tno,host)
643     } else {
644         set zz z39
645         set host $hist($setNo,host)
646     }
647
648     if {![lindex $targets($host) 5]} {
649         set elements {}
650     }
651
652     $zz.$setNo elementSetNames $elements
653     $zz.$setNo recordElements $elements
654     set toGet [expr 1 + $setMax - $setOffset]
655
656     $zz callback [list search-response $zz.$setNo]
657
658     while {$setMax > 0 && $toGet > 0} {
659         for {set got 0} {$got < $toGet} {incr got} {
660             if {[$zz.$setNo type [expr $setOffset + $got]] == ""} {
661                 break
662             }
663         }
664         if {$got < $toGet} {
665             set sessionWait 0
666             $zz.$setNo present $setOffset $toGet
667             if {[catch {zwait sessionWait 300}]} {
668                 wlog debug "timeout/cancel in present"
669                 $zz disconnect
670                 break
671             }
672             if {$sessionWait == "0"} {
673                 $zz disconnect
674             }
675             if {$sessionWait != "1"} {
676                 break
677             }
678             set got [$zz.$setNo numberOfRecordsReturned]
679             if {$got <= 0} {
680                 break
681             }
682         }
683         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno
684         set setOffset [expr $got + $setOffset]
685         set toGet [expr 1 + $setMax - $setOffset]
686         wflush
687     }
688 }
689
690 proc z39history {} {
691     global nextSetNo
692     global hist
693     global env
694     global sessionId
695     global targets
696
697     if {![info exists nextSetNo]} {
698         return
699     }
700     html "<hr><h3>History</h3><dl>\n"
701     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
702         html {<dt> <a href="http:} $env(SCRIPT_NAME)
703         html / $sessionId {/search.egw/} $setNo + 1
704         html + $hist($setNo,maxPresent)
705         html {"> } [lindex $targets($hist($setNo,host)) 0]
706         if {[llength $hist($setNo,database)] > 1} {
707             html ": "
708             foreach b $hist($setNo,database) {
709                 html " $b"
710             }
711         }
712         html "</a>\n"
713         html "<dd> "
714         if {[info exists hist($setNo,hits)]} {
715             html $hist($setNo,hits) " hits"
716         } else {
717             html failed
718         }
719         html "\n"
720     }
721     html "</dl>\n"
722 }
723
724 proc displayError {msga msgb} {
725     html "<p><center>\n"
726     html {<img src="/gif/noway.gif">}
727     html "<h2>" $msga "</h2>\n"
728     if {$msgb != ""} {
729         html "<h3>" $msgb "</h3>\n"
730     }
731     html "</center><p>\n"
732 }