Logs of changes.

[egate.git] / www / z39util.tcl

diff --git a/www/z39util.tcl b/www/z39util.tcl
index 8740be4..bfa5608 100644 (file)
--- a/www/z39util.tcl
+++ b/www/z39util.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: z39util.tcl,v 1.36 1996/03/07 12:46:09 adam Exp $
+# $Id: z39util.tcl,v 1.37 1996/03/08 16:47:08 adam Exp $
 #
 proc saveState {} {
     uplevel #0 {
@@ -85,8 +85,10 @@ proc display-brief {zset no setNo targetNo} {
     }
     set rtype [$zset recordType $no]
     if {$rtype == "SUTRS"} {
+        html { <a href="http:} $env(SCRIPT_NAME) /
+        html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
         html [join [$zset getSutrs $no]]
-        html "<br>\n"
+        html "</a><br>\n"
         return
     }
     if {$rtype == "WAIS"} {
@@ -349,7 +351,7 @@ proc display-full-wais {zset no setNo targetNo} {
         }
     }
     if {![info exists data(title)] || ![info exists data(linkage)]} {
-        html "<tt>" [join [$zset getWAIS $no text]] "</tt>\n"
+        html "<pre>" [join [$zset getWAIS $no text]] "\n</pre>\n"
         return
     }
     html {Title: } {<a href="} $data(linkage) {">} $data(title) "</a><br>\n"
@@ -394,7 +396,9 @@ proc display-full {zset no setNo targetNo} {
     }
     set rtype [$zset recordType $no]
     if {$rtype == "SUTRS"} {
-        html [join [$zset getSutrs $no]] "<br>\n"
+        html "<pre>"
+        html [join [$zset getSutrs $no]]
+        html "</pre><br>\n"
         return
     }
     if {$rtype == "WAIS"} {
@@ -529,7 +533,7 @@ 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 compare [lindex $targets($t) 1] WAIS]} {
             if {[string length $op] == 0} {
                 set q $term
             } else {
@@ -540,11 +544,16 @@ proc build-query {t ilines} {
         }                
         if {[string length $term] > 0} {
             set field [join [egw_form menu$i]]
+            catch {unset attr}
             foreach x [lindex $targets($t) 2] {
-                if {[lindex $x 0] == $field} {
+                if {![string compare [lindex $x 0] $field]} {
                     set attr [lindex $x 1]
                 }
             }
+            if {![info exists attr]} {
+                egw_log debug "attr failed for $t"
+                set attr [lindex [lindex [lindex $targets($t) 2] 0] 1]
+            }
             switch $op {
             And
                 { set q "@and $q ${attr} \"${term}\"" }
@@ -781,10 +790,12 @@ proc z39search {setNo piggy tno elements} {
         }
     }
     
-    if {[lindex $targets($host) 6] == "1"} {
+    if {![string compare [lindex $targets($host) 1] WAIS]} {
         wais-set $zz.$setNo $zz
     } else {
         ir-set $zz.$setNo $zz
+        $zz.$setNo preferredRecordSyntax [lindex $targets($host) 1]
+        egw_log debug "set syntax to [lindex $targets($host) 1]"
     }
     if {![lindex $targets($host) 5]} {
         set elements {}
@@ -796,8 +807,6 @@ proc z39search {setNo piggy tno elements} {
     egw_log debug "database=$database"
     eval $zz.$setNo databaseNames $database
 
-    $zz.$setNo preferredRecordSyntax USMARC
-
     $zz callback [list search-response $zz.$setNo]
     if {$piggy} {
         $zz.$setNo largeSetLowerBound 999999
@@ -974,15 +983,17 @@ proc z39msearch {setNo elements start number cache} {
             }
             continue
         }
-        if {[catch [list z39$i.$setNo preferredRecordSyntax USMARC]]} {
+        if {[catch [list z39$i.$setNo preferredRecordSyntax]]} {
             if {$debug} {
                 html "ok<br>\n"
             }
 
-            if {[lindex $targets($host) 6] == "1"} {
+            if {![string compare [lindex $targets($host) 1] WAIS]} {
                 wais-set z39$i.$setNo z39$i
             } else {
                 ir-set z39$i.$setNo z39$i
+                z39$i.$setNo preferredRecordSyntax [lindex $targets($host) 1]
+                egw_log debug "set syntax to [lindex $targets($host) 1]"
             }
             set hist($setNo,$i,offset) 0
             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
@@ -997,7 +1008,6 @@ proc z39msearch {setNo elements start number cache} {
             z39$i.$setNo elementSetNames $thisElements
             z39$i.$setNo recordElements $thisElements
 
-            z39$i.$setNo preferredRecordSyntax USMARC
             z39$i callback [list search-m-response $setNo $i $start $number]
 
             if {$start == 1} {
@@ -1049,7 +1059,6 @@ proc z39msearch {setNo elements start number cache} {
             }
             
             html "present<br>\n"
-            z39$i.$setNo preferredRecordSyntax USMARC
             z39$i callback [list search-m-response $setNo $i $start $tnumber]
             incr zleft
             egw_log debug "mpresent start=$start number=$tnumber"
@@ -1164,6 +1173,86 @@ proc buttons-result-set-s {setNo targetNo setMax startPos after} {
     html "<p>\n"
 }
 
+proc display-result-set-m-score {setNo} {
+    global hist
+    global useIcons
+    global zstatus
+    global targets
+
+    set not $hist($setNo,0,host)
+    for {set i 1} {$i <= $not} {incr i} {
+        if {[lindex $status 0] != "DBOSD"} continue
+        
+        if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} {
+            set nor $hist($setNo,$i,maxPresent)
+        } else {
+            set nor $hist($setNo,$i,offset)
+        }
+        for {set j 1} {$j < $not} {incr j} {
+            if {![string compare [z39$i.$setNo recordType] WAIS]} {
+                lappend scoreArray [list \
+                        [z39$i.$setNo getWAIS $j score] $i $setNo $j]
+            } else {
+                lappend scoreArray [list 0 $i $setNo $j]
+            }
+        }
+    }
+    html "score merge<br>"
+}
+
+proc display-result-set-m-server {setNo} {
+    global hist
+    global useIcons
+    global zstatus
+    global targets
+
+    set not $hist($setNo,0,host)
+    html "<dl>\n"
+    for {set i 1} {$i <= $not} {incr i} {
+        if {$zstatus($i) != 2} continue
+        html "<dt><h3>" [lindex $targets($hist($setNo,$i,host)) 0] ": "
+        set status [z39$i.$setNo responseStatus]
+        if {[lindex $status 0] == "NSD"} {
+            z39$i.$setNo nextResultSetPosition 0
+            set code [lindex $status 1]
+            set msg [lindex $status 2]
+            set addinfo [lindex $status 3]
+            html "Error</h3>\n<dd>NSD$code: $msg: $addinfo"
+        } else {
+            set r [z39$i.$setNo resultCount]
+            html "$r hits</h3>\n<dd>\n<ul>\n"
+            
+            if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} {
+                display-rec 1 $hist($setNo,maxPresent) \
+                        display-brief $setNo $i
+            } else {
+                display-rec 1 $hist($setNo,$i,offset) \
+                        display-brief $setNo $i
+            }
+            html "</ul>"
+        }
+        html "\n"
+    }
+    html "</dl>\n"
+}
+
+proc display-result-set-m {setNo} {
+    global hist
+    global useIcons
+    global zstatus
+    global targets
+
+    egw_log debug "sort=$hist($setNo,sort)"
+    switch $hist($setNo,sort) {
+        score {
+            display-result-set-m-score $setNo
+        }
+        default {
+            display-result-set-m-server $setNo
+        }
+    }
+}
+
 proc display-result-set-s {setNo targetNo startPos endPos} {
     global hist
     global useIcons
@@ -1468,7 +1557,7 @@ proc maintenance {} {
 }
 
 proc splitHostSpec {host} {
-    set i [string last . $host]
+    set i [string first / $host]
     if {$i > 1} {
         incr i -1
         return [string range $host 0 $i]
@@ -1476,6 +1565,17 @@ proc splitHostSpec {host} {
     return $host
 }
 
+proc splitDatabaseSpec {host} {
+    set i [string first / $host]
+    if {$i > 1} {
+        incr i
+        regsub -all -- - [string range $host $i end] { } res
+        return $res
+    }
+    regsub -all -- - $host {} res
+    return $res
+}
+
 proc mergeHostSpec {host databases} {
     return ${host}.[join $databases -]
 }
@@ -1484,13 +1584,13 @@ proc mkAssoc {assoc host} {
     global targets
 
     if {[catch {$assoc failback fail-response}]} {
-        if {[lindex $targets($host) 6] == "1"} {
+        if {![string compare [lindex $targets($host) 1] WAIS]} {
             wais $assoc
         } else {
             ir $assoc
         }
     } else {
-        if {[lindex $targets($host) 6] == "1"} {
+        if {![string compare [lindex $targets($host) 1] WAIS]} {
             if {[$assoc comstack] == "wais"} return
             wais $assoc
         } else {