Lots of changes. They aren't visible though.
[egate.git] / www / z39util.tcl
index 8553519..8740be4 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: z39util.tcl,v 1.33 1996/02/21 16:57:39 adam Exp $
+# $Id: z39util.tcl,v 1.36 1996/03/07 12:46:09 adam Exp $
 #
 proc saveState {} {
     uplevel #0 {
@@ -65,12 +65,10 @@ proc fail-response {} {
     set sessionWait -1
 }
 
-proc display-brief {zset no tno} {
+proc display-brief {zset no setNo targetNo} {
     global env
-    global setNo
     global sessionId
 
-
     html {<li>}
     set type [$zset type $no]
     if {$type == "SD"} {
@@ -90,7 +88,15 @@ proc display-brief {zset no tno} {
         html [join [$zset getSutrs $no]]
         html "<br>\n"
         return
-    } 
+    }
+    if {$rtype == "WAIS"} {
+        html { <a href="http:} $env(SCRIPT_NAME) /
+        html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
+        html [join [$zset getWAIS $no headline]]
+        html {</a>}
+        html "<br>\n"
+        return
+    }
     if {![catch {
         set author [$zset getMarc $no field 100 * a]
         set corp [$zset getMarc $no field 110 * a]
@@ -106,7 +112,7 @@ proc display-brief {zset no tno} {
         set year [$zset getMarc $no field 260 * c]
     } dispError ] } {
         html { <a href="http:} $env(SCRIPT_NAME) /
-        html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
+        html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
         set p 0
         foreach a $author {
             if {$p} {
@@ -152,7 +158,7 @@ proc display-brief {zset no tno} {
         html {</a> }
     } else {
         html { <a href="http:} $env(SCRIPT_NAME) /
-        html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
+        html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
         html {No Title}
         html {</a> }
         html "Error: " $dispError "\n"
@@ -297,7 +303,82 @@ proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
     }
 }
 
-proc display-full {zset no tno} {
+proc display-full-wais {zset no setNo targetNo} {
+    global env
+    global hist
+    global sessionId
+
+    set i 0    
+    set element junk
+    htmlToken l [join [$zset getWAIS $no text]] {
+        if {[string compare [string index $l 0] {<}]} {
+            set data($element) $l
+            continue
+        }
+        switch -exact $l {
+            <ti> {
+                set element title 
+            }
+            <dm> {
+                set element dateOfLastModification
+            }
+            <ci> {
+                set element controlIdentifier
+            }
+            <lc> {
+                set element lastChecked
+            }
+            <by> {
+                set element bytes
+            }
+            <avli> {
+                set element linkage
+            }
+            <cr> {
+                incr i
+            }
+            <li> {
+                set element "$i,linkage"
+            }
+            <cp> {
+                set element "$i,title"
+            }
+            default {
+                set element junk
+            }
+        }
+    }
+    if {![info exists data(title)] || ![info exists data(linkage)]} {
+        html "<tt>" [join [$zset getWAIS $no text]] "</tt>\n"
+        return
+    }
+    html {Title: } {<a href="} $data(linkage) {">} $data(title) "</a><br>\n"
+    html {URL: } $data(linkage) "<br>\n"
+    html {Score: } [$zset getWAIS $no score] "<br>\n"
+    html {Lines: } [$zset getWAIS $no lines] "<br>\n"
+    if {[info exists data(bytes)]} {
+        html {Bytes: } $data(bytes) "<br>\n"
+    }
+    if {[info exists data(dateOfLastModification)]} {
+        html {Last modified: } $data(dateOfLastModification) "<br>\n"
+    }
+    if {[info exists data(lastChecked)]} {
+        html {Last checked: } $data(lastChecked) "<br>\n"
+    }
+    html {<a href="} $env(SCRIPT_NAME) / $sessionId {/sameas.egw/}
+    html $setNo + $targetNo + 1 + $hist($setNo,maxPresent) +
+    html [egw_enc [$zset getWAIS $no documentID]] {">}
+    html {Similar WAIS record</a><br>}
+    html "<ul>\n"
+    for {set i 1} {[info exists data($i,linkage)]} {incr i} {
+        html {<li><a href="} $data($i,linkage) {">}
+        html $data($i,title) "</a><br>\n"
+        html "URL: " $data($i,linkage)
+    }
+    html "</ul>\n"
+}
+
+proc display-full {zset no setNo targetNo} {
     set type [$zset type $no]
     if {$type == "SD"} {
         set err [lindex [$zset diag $no] 1]
@@ -315,7 +396,11 @@ proc display-full {zset no tno} {
     if {$rtype == "SUTRS"} {
         html [join [$zset getSutrs $no]] "<br>\n"
         return
-    } 
+    }
+    if {$rtype == "WAIS"} {
+        display-full-wais $zset $no $setNo $targetNo
+        return
+    }
     if {[catch {set r [$zset getMarc $no line * * *]}]} {
         html "Unknown record type: $rtype <br>\n"
         return
@@ -413,19 +498,10 @@ proc display-full {zset no tno} {
 }
 
 
-proc display-rec {from to dfunc tno} {
-    global setNo
-
-    if {$tno > 0} {
-        while {$from <= $to} { 
-            eval "$dfunc z39${tno}.${setNo} $from $tno"
-            incr from
-        }
-    } else {
-        while {$from <= $to} { 
-            eval "$dfunc z39.${setNo} $from 0"
-            incr from
-        }
+proc display-rec {from to dfunc setNo targetNo} {
+    while {$from <= $to} { 
+        eval "$dfunc z39${targetNo}.${setNo} $from $setNo $targetNo"
+        incr from
     }
 }
 
@@ -453,6 +529,15 @@ proc build-query {t ilines} {
     set q {}
     for {set i 1} {$i <= $ilines} {incr i} {
         set term [join [egw_form entry$i]]
+        if {[lindex $targets($t) 6] == "1"} {
+            if {[string length $op] == 0} {
+                set q $term
+            } else {
+                set q "$term $q"
+            }
+            set op [egw_form logic$i]
+            continue
+        }                
         if {[string length $term] > 0} {
             set field [join [egw_form menu$i]]
             foreach x [lindex $targets($t) 2] {
@@ -481,24 +566,14 @@ proc z39scan {setNo scanNo tno scanLines scanPos cache} {
     global sessionWait
     global targets
 
-    if {$tno > 0} {
-        set zz z39$tno
-        set host $hist($setNo,$tno,host)
-        set idAuth $hist($setNo,$tno,idAuthentication)
-        set database $hist($setNo,$tno,database)
-        set scanAttr $hist($setNo,$tno,scanAttr)
-        set scanTerm $hist($setNo,$tno,$scanNo,scanTerm)
-    } else {
-        set zz z39
-        set host $hist($setNo,host)
-        set idAuth $hist($setNo,idAuthentication)
-        set database $hist($setNo,database)
-        set scanAttr $hist($setNo,scanAttr)
-        set scanTerm $hist($setNo,$scanNo,scanTerm)
-    }
-    if {[catch [list $zz failback fail-response]]} {
-        ir $zz
-    }
+    set zz z39$tno
+    set host $hist($setNo,$tno,host)
+    set idAuth $hist($setNo,$tno,idAuthentication)
+    set database $hist($setNo,$tno,database)
+    set scanAttr $hist($setNo,scanAttr)
+    set scanTerm $hist($setNo,$scanNo,scanTerm)
+
+    mkAssoc $zz $host
     if {[catch [list set oldHost [$zz connect]]]} {
         set oldHost ""
     }
@@ -589,11 +664,7 @@ proc display-scan {setNo scanNo tno} {
     global env
     global sessionId
 
-    if {$tno > 0} {
-        set zz z39$tno
-    } else {
-        set zz z39
-    }
+    set zz z39$tno
     set zs $zz.s$scanNo.$setNo
     set m [$zs numberOfEntriesReturned]
         
@@ -626,7 +697,7 @@ proc display-scan {setNo scanNo tno} {
         } else {
             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
             html {<a href="http:} $env(SCRIPT_NAME)
-            html / $sessionId {/search.egw/} $setNo +
+            html / $sessionId {/search.egw/} $setNo + $tno +
             html hyper + $tterm {">}
         }
         html [lindex [$zs scanLine $i] 1]
@@ -643,22 +714,14 @@ proc z39search {setNo piggy tno elements} {
     global sessionWait
     global targets
 
-    if {$tno > 0} {
-        set zz z39$tno
-        set host $hist($setNo,$tno,host)
-        set idAuth $hist($setNo,$tno,idAuthentication)
-        set database $hist($setNo,$tno,database)
-        set query $hist($setNo,$tno,query)
-    } else {
-        set zz z39
-        set host $hist($setNo,host)
-        set idAuth $hist($setNo,idAuthentication)
-        set database $hist($setNo,database)
-        set query $hist($setNo,query)
-    }
-    if {[catch [list $zz failback fail-response]]} {
-        ir $zz
-    }
+    set zz z39$tno
+    set host $hist($setNo,$tno,host)
+    set idAuth $hist($setNo,$tno,idAuthentication)
+    set database $hist($setNo,$tno,database)
+    set query $hist($setNo,$tno,query)
+    catch {set docId $hist($setNo,$tno,queryId)}
+
+    mkAssoc $zz $host
     if {[catch [list set oldHost [$zz connect]]]} {
         set oldHost ""
     }
@@ -690,7 +753,7 @@ proc z39search {setNo piggy tno elements} {
            $zz disconnect
             return 0
         }
-        if {[catch {egw_wait sessionWait 60}]} {
+        if {$sessionWait == 0 && [catch {egw_wait sessionWait 60}]} {
             displayError "Cannot initialize target" $thisHost
            $zz disconnect
             return 0
@@ -717,8 +780,12 @@ proc z39search {setNo piggy tno elements} {
             }
         }
     }
-    ir-set $zz.$setNo $zz
-
+    
+    if {[lindex $targets($host) 6] == "1"} {
+        wais-set $zz.$setNo $zz
+    } else {
+        ir-set $zz.$setNo $zz
+    }
     if {![lindex $targets($host) 5]} {
         set elements {}
     }
@@ -743,9 +810,14 @@ proc z39search {setNo piggy tno elements} {
     }
     set sessionWait 0
     egw_log debug "search: $query"
-    $zz.$setNo search $query
 
-    if {[catch {egw_wait sessionWait 60}]} {
+    if {[info exists docId]} {
+        $zz.$setNo search $query $docId
+    } else {
+        $zz.$setNo search $query
+    }
+
+    if {!$sessionWait && [catch {egw_wait sessionWait 60}]} {
         egw_log debug "timeout/cancel in search"
         displayError "Timeout in search" {}
         html "</body></html>\n"
@@ -858,9 +930,7 @@ proc z39msearch {setNo elements start number cache} {
     egw_log debug "z39msearch start=$start number=$number elements=$elements"
     for {set i 1} {$i <= $not} {incr i} {
         set host $hist($setNo,$i,host)
-        if {[catch [list z39$i failback fail-m-response $i]]} {
-            ir z39$i
-        }
+        mkAssoc z39$i $host
         set oldHost [z39$i connect]
         set thisHost [splitHostSpec $host]
         if {[string compare $oldHost $thisHost]} {
@@ -874,7 +944,7 @@ proc z39msearch {setNo elements start number cache} {
         set oldHost [z39$i connect]
         set host $hist($setNo,$i,host)
         set thisHost [splitHostSpec $host]
-        if {![string compare $oldhost $thisHost]} {
+        if {![string compare $oldHost $thisHost]} {
             continue
         }
         egw_log debug "old=$oldHost this=$thisHost"
@@ -893,8 +963,9 @@ proc z39msearch {setNo elements start number cache} {
     }
     set zleft 0
     for {set i 1} {$i <= $not} {incr i} {
+        set host $hist($setNo,$i,host)
         if {$debug} {
-            html "host " [splitHostSpec $hist($setNo,$i,host)] ": "
+            html "host " [splitHostSpec $host] ": "
         }
         egw_log debug "i=$i zstatus=$zstatus($i)"
         if {$zstatus($i) < 1} {
@@ -907,7 +978,12 @@ proc z39msearch {setNo elements start number cache} {
             if {$debug} {
                 html "ok<br>\n"
             }
-            ir-set z39$i.$setNo z39$i
+
+            if {[lindex $targets($host) 6] == "1"} {
+                wais-set z39$i.$setNo z39$i
+            } else {
+                ir-set z39$i.$setNo z39$i
+            }
             set hist($setNo,$i,offset) 0
             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
 
@@ -1004,13 +1080,8 @@ proc z39present {setNo tno setOffset setMax dfunc elements} {
     global sessionWait
     global targets
 
-    if {$tno > 0} {
-        set zz z39$tno
-        set host $hist($setNo,$tno,host)
-    } else {
-        set zz z39
-        set host $hist($setNo,host)
-    }
+    set zz z39$tno
+    set host $hist($setNo,$tno,host)
 
     if {![lindex $targets($host) 5]} {
         set elements {}
@@ -1047,13 +1118,114 @@ proc z39present {setNo tno setOffset setMax dfunc elements} {
                 break
             }
         }
-        display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno
+        display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $setNo $tno
         set setOffset [expr $got + $setOffset]
         set toGet [expr 1 + $setMax - $setOffset]
         egw_flush
     }
 }
 
+proc buttons-result-set-s {setNo targetNo setMax startPos after} {
+    global sessionId
+    global useIcons
+    global env
+    global hist
+
+    set zz z39$targetNo
+    html "<p>\n"
+    button-europagate
+    if {$setMax > 0 && $setMax < [$zz.$setNo resultCount]} {
+        html {<a href="http:} $env(SCRIPT_NAME)
+        html / $sessionId {/search.egw/} $setNo + $targetNo + 
+        html [expr $setMax + 1] + [expr $setMax + $hist($setNo,maxPresent)]
+        if {$useIcons} {
+            html {"><img src="/egwgif/button-next-records.gif" alt="Next Records"}
+           html { border=0></a>}
+        } else {
+            html {">Next Records</a>} " | \n"
+        }
+    }
+    if {$setMax > 0 && $startPos != "" && $startPos != "1"} {
+        html {<a href="http:} $env(SCRIPT_NAME)
+        html / $sessionId {/search.egw/} $setNo + $targetNo
+        html + [expr $startPos - $hist($setNo,maxPresent)]
+        html + [expr $startPos - 1]
+        if {$useIcons} {
+            html {"><img src="/egwgif/button-previous-records.gif" }
+           html {alt="Previous Records" border=0></a>}
+        } else {
+            html {">Previous Records</a>} " | \n"
+        }
+    }
+    button-new-query 1 $setNo
+    button-new-target 1
+    button-view-history 0
+
+    html "<p>\n"
+}
+
+proc display-result-set-s {setNo targetNo startPos endPos} {
+    global hist
+    global useIcons
+
+    set zz z39$targetNo
+    set host $hist($setNo,$targetNo,host)
+    set idAuth $hist($setNo,$targetNo,idAuthentication)
+    set database $hist($setNo,$targetNo,database)
+    set query $hist($setNo,$targetNo,query)
+
+    set useIcons 1
+
+    if {$startPos == ""} {
+        if {[z39search $setNo 1 $targetNo B] != "1"} {
+            return
+        }
+        set r [$zz.$setNo resultCount]
+
+        set setMax [$zz.$setNo resultCount]
+        if {$setMax > $hist($setNo,maxPresent)} {
+            set setMax $hist($setNo,maxPresent)
+        }
+        buttons-result-set-s $setNo $targetNo $setMax $startPos 0
+
+        set setOffset [$zz.$setNo numberOfRecordsReturned]
+        if {$setMax > 0} {
+            html {<h3> Records 1-} $setMax " out of $r</h3>\n"
+        } else {
+            html "<h3> No hits</h3>\n"
+        }
+        egw_flush
+        html "<ul>\n"
+        display-rec 1 $setMax display-brief $setNo $targetNo
+        incr setOffset
+
+    } else {
+        if {[z39search $setNo 0 $targetNo B] != "1"} {
+            return 
+        }
+        set r [$zz.$setNo resultCount]
+        set setOffset $startPos
+        set setMax [$zz.$setNo resultCount]
+        if {$setMax > $endPos} {
+            set setMax $endPos
+        }
+        buttons-result-set-s $setNo $targetNo $setMax $startPos 0
+        if {$setMax > 0} {
+            html {<h3> Records } $startPos {-} $setMax " out of $r</h3>\n"
+        } else {
+            html "<h3> No hits</h3>\n"
+        }
+        egw_flush
+        html "<ul>\n"
+    }
+    if {$setMax > 0} {
+        z39present $setNo $targetNo $setOffset $setMax display-brief B
+    }
+    html "</ul>\n"
+    set useIcons 0
+    buttons-result-set-s $setNo $targetNo $setMax $startPos 1
+}
+
 proc z39history {} {
     global nextSetNo
     global hist
@@ -1062,6 +1234,7 @@ proc z39history {} {
     global targets
     global html3
 
+    set targetNo 0
     if {![info exists nextSetNo]} {
         return
     }
@@ -1078,7 +1251,7 @@ proc z39history {} {
     }
     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
         if {$hist($setNo,scan) > 0} continue
-        set host $hist($setNo,host)
+        set host $hist($setNo,0,host)
         if {$html3} {
             html {<td align=left>}
         } else {
@@ -1086,11 +1259,11 @@ proc z39history {} {
         }
         html [lindex $targets($host) 0]
         if {$html3} {
-            html {<td align=left>} [join $hist($setNo,database)]
+            html {<td align=left>} [join $hist($setNo,0,database)]
         } else {
             if {[llength [lindex $targets($host) 1]] > 1} {
                 html ": "
-                foreach b $hist($setNo,database) {
+                foreach b $hist($setNo,0,database) {
                     html " $b"
                 }
             }
@@ -1101,7 +1274,7 @@ proc z39history {} {
         }
         if {[info exists hist($setNo,hits)]} {
             html { <a href="http:} $env(SCRIPT_NAME)
-            html / $sessionId {/search.egw/} $setNo + 1
+            html / $sessionId {/search.egw/} $setNo + $targetNo + 1
             html + $hist($setNo,maxPresent)
             if {1} {
                 html {">} $hist($setNo,hits) {</a>}
@@ -1248,7 +1421,7 @@ proc button-new-query {more setNo} {
     if {$mMode} {
         html {/mquery.egw/} $setNo
     } else {
-        html {/query.egw/} $hist($setNo,host) + $setNo
+        html {/query.egw/} $hist($setNo,0,host) + $setNo
     }
     html {">}
     if {$useIcons} {
@@ -1270,8 +1443,9 @@ proc button-scan-window {more setNo} {
     global sessionId
     global hist
 
+    set targetNo 0
     html {<a href="http:} $env(SCRIPT_NAME)
-    html / $sessionId {/search.egw/} $setNo + {scan} {">}
+    html / $sessionId {/search.egw/} $setNo + $targetNo + {scan} {">}
     if {$useIcons} {
         html {<img src="/egwgif/button-scan-window.gif" }
        html {alt="Scan" border=0></a>}
@@ -1305,3 +1479,23 @@ proc splitHostSpec {host} {
 proc mergeHostSpec {host databases} {
     return ${host}.[join $databases -]
 }
+
+proc mkAssoc {assoc host} {
+    global targets
+
+    if {[catch {$assoc failback fail-response}]} {
+        if {[lindex $targets($host) 6] == "1"} {
+            wais $assoc
+        } else {
+            ir $assoc
+        }
+    } else {
+        if {[lindex $targets($host) 6] == "1"} {
+            if {[$assoc comstack] == "wais"} return
+            wais $assoc
+        } else {
+            if {[$assoc comstack] == "tcpip"} return
+            ir $assoc
+        }
+    }
+}
\ No newline at end of file