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