More general multi-search algorithm with cached records.
[egate.git] / www / z39util.tcl
index e703062..1d78f64 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: z39util.tcl,v 1.27 1996/01/26 17:41:26 adam Exp $
+# $Id: z39util.tcl,v 1.28 1996/01/29 17:31:48 adam Exp $
 #
 proc saveState {} {
     uplevel #0 {
@@ -782,15 +782,48 @@ proc fail-m-response {i} {
     incr zleft -1
 }
 
-proc search-m-response {setNo i} {
+proc search-m-response {setNo i start number} {
     global zleft
     global zstatus
+    global hist
 
-    incr zleft -1
-    set zstatus($i) 2
+    egw_log debug "search-m-response"
+    set status [z39$i.$setNo responseStatus]
+    egw_log debug "search-m-response1"
+    if {[lindex $status 0] != "DBOSD"} {
+        egw_log debug "search-m-response2"
+        incr zleft -1
+        set zstatus($i) 2
+        return
+    }
+    set nor [z39$i.$setNo numberOfRecordsReturned]
+    egw_log debug "search-m-response3"
+    set hist($setNo,$i,offset) [expr $start + $nor -1]
+    if {[expr $nor + $start] >= [z39$i.$setNo resultCount]} {
+        egw_log debug "search-m-response4"
+        incr zleft -1
+        set zstatus($i) 2
+        return
+    }
+    egw_log debug "search-m-response5"
+    if {$nor >= $number} {
+        egw_log debug "search-m-response6"
+        incr zleft -1
+        set zstatus($i) 2
+        return
+    }
+    egw_log debug "search-m-response7"
+    set start [expr $start + $nor]
+    set number [expr $number - $nor]
+    if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
+        set number [expr [z39$i.$setNo resultCount] - $start + 1]
+    }
+    z39$i callback [list search-m-response $setNo $i $start $number]
+    egw_log debug "mpresent start=$number number=$number"
+    z39$i.$setNo present $start $number
 }
 
-proc z39msearch {setNo piggy elements} {
+proc z39msearch {setNo elements start number cache} {
     global zleft
     global zstatus
     global hist
@@ -800,12 +833,10 @@ proc z39msearch {setNo piggy elements} {
 
     for {set i 1} {$i <= $not} {incr i} {
         set host $hist($setNo,$i,host)
-        if {[catch {z39 failback fail-response}]} {
+        if {[catch [list z39$i failback fail-m-response $i]]} {
             ir z39$i
         }
-        if {[catch {set oldHost [z39$i connect]}]} {
-            set oldHost ""
-        }
+        set oldHost [z39$i connect]
         set thisHost [splitHostSpec $host]
         if {$oldHost != $thisHost} {
             catch {z39$i disconnect}
@@ -819,9 +850,9 @@ proc z39msearch {setNo piggy elements} {
         set host $hist($setNo,$i,host)
         set thisHost [splitHostSpec $host]
         if {$oldHost == $thisHost} {
-            set zstatus($i) 1
             continue
         }
+        egw_log debug "old=$oldHost this=$thisHost"
         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
         html "Connecting to target " $thisHost " <br>\n"
         set zstatus($i) -1
@@ -831,15 +862,20 @@ proc z39msearch {setNo piggy elements} {
     }
     while {$zleft > 0} {
         egw_log debug "Waiting for init response"
-        if {[catch {egw_wait zleft 10}]} {
+        if {[catch {egw_wait zleft 20}]} {
             break
         }
     }
     set zleft 0
     for {set i 1} {$i <= $not} {incr i} {
         html "host " [splitHostSpec $hist($setNo,$i,host)] ": "
-        if {$zstatus($i) >= 1} {
-            html "ok <br>\n"
+        egw_log debug "i=$i zstatus=$zstatus($i)"
+        if {$zstatus($i) < 1} {
+            html "fail<br>\n"
+            continue
+        }
+        if {[catch [list z39$i.$setNo preferredRecordSyntax USMARC]]} {
+            html "ok<br>\n"
             ir-set z39$i.$setNo z39$i
             set hist($setNo,$i,offset) 0
             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
@@ -851,38 +887,74 @@ proc z39msearch {setNo piggy elements} {
             }
             z39$i.$setNo smallSetElementSetNames $thisElements
             z39$i.$setNo mediumSetElementSetNames $thisElements
+            z39$i.$setNo elementSetNames $thisElements
             z39$i.$setNo recordElements $thisElements
 
             z39$i.$setNo preferredRecordSyntax USMARC
-            z39$i callback [list search-m-response $setNo $i]
+            z39$i callback [list search-m-response $setNo $i $start $number]
 
-            if {$piggy} {
+            if {$start == 1} {
                 z39$i.$setNo largeSetLowerBound 999999
                 z39$i.$setNo smallSetUpperBound 0
-                z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
+                z39$i.$setNo mediumSetPresentNumber $number
             } else {
                 z39$i.$setNo largeSetLowerBound 2
                 z39$i.$setNo smallSetUpperBound 0
                 z39$i.$setNo mediumSetPresentNumber 0
             }
             set zstatus($i) 1
-            egw_log debug "search " $hist($setNo,$i,query)
+            incr zleft
+            egw_log debug "setNo=$setNo msearch " $hist($setNo,$i,query)
             z39$i.$setNo search $hist($setNo,$i,query)
+        } elseif {[z39$i.$setNo resultCount] >= $start} {
+            if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
+                set tnumber [expr [z39$i.$setNo resultCount] - $start + 1]
+            } else {
+                set tnumber $number
+            }
+            if {![lindex $targets($hist($setNo,$i,host)) 5]} {
+                set thisElements {}
+            } else {
+                set thisElements $elements
+            }
+            z39$i.$setNo smallSetElementSetNames $thisElements
+            z39$i.$setNo mediumSetElementSetNames $thisElements
+            z39$i.$setNo elementSetNames $thisElements
+            z39$i.$setNo recordElements $thisElements
+
+            for {set n 0} {$n < $tnumber} {incr n} {
+                if {[z39$i.$setNo type [expr $start + $n]] == ""} {
+                    if {$n > 0} {
+                        egw_log debug "failed on $n"
+                    }
+                    break
+                }
+            }
+            if {$n == $tnumber} {
+                html "cached<br>\n"
+                continue
+            }
+            
+            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"
+            z39$i.$setNo present $start $tnumber
         } else {
-            html "fail <br>\n"
+            html "ok<br>\n"
         }
     }
     while {$zleft > 0} {
-        egw_log debug "Waiting for search response"
-        if {[catch {egw_wait zleft 30}]} {
+        egw_log debug "Waiting for search/present response"
+        if {[catch {egw_wait zleft 60}]} {
             break
         }
     }
     for {set i 1} {$i <= $not} {incr i} {
         if {$zstatus($i) != 2} continue
         set status [z39$i.$setNo responseStatus]
-        if {[lindex $status 0] != "NSD"} {
+        if {0 && [lindex $status 0] != "NSD"} {
             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
         }
     }
@@ -1177,7 +1249,7 @@ proc button-scan-window {more setNo} {
 proc maintenance {} {
     html {<hr>This page is maintained by }
     html {<a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.}
-    html {Last modified 26. january 1996. <br>}
+    html {Last modified 29. january 1996. <br>}
     html {<em> This and the following pages are under construction and }
     html {will continue to be so until the end of January 1996.</em>}
 }