X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fz39util.tcl;h=aa5378202b21b4ded38f4edb51340988c5e66e0b;hb=25db261b6bbbfcc7bc26f679f195b51d31b9d7d7;hp=451fb70af4e1c44487b44c1c021747b187c2216c;hpb=2e38b5dbea87903010208d15a8a9073d2049bbae;p=egate.git

diff --git a/www/z39util.tcl b/www/z39util.tcl
index 451fb70..aa53782 100644
--- a/www/z39util.tcl
+++ b/www/z39util.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: z39util.tcl,v 1.29 1996/01/31 15:56:37 adam Exp $
+# $Id: z39util.tcl,v 1.34 1996/02/29 15:41:40 adam Exp $
 #
 proc saveState {} {
     uplevel #0 {
@@ -70,7 +70,6 @@ proc display-brief {zset no tno} {
     global setNo
     global sessionId
 
-
     html {<li>}
     set type [$zset type $no]
     if {$type == "SD"} {
@@ -90,7 +89,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 + $tno + $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]
@@ -104,7 +111,7 @@ proc display-brief {zset no tno} {
 	set location [$zset getMarc $no field 260 * a] 
 	set publisher [$zset getMarc $no field 260 * b]
         set year [$zset getMarc $no field 260 * c]
-    } ] } {
+    } dispError ] } {
         html { <a href="http:} $env(SCRIPT_NAME) /
         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
         set p 0
@@ -140,12 +147,22 @@ proc display-brief {zset no tno} {
         if {$nope} {
             set v [join $cover ""]
             if {[string length $v] > 40} {
+                set nope 0
                 html [string range $v 0 38] "..."
-            } else {
+            } elseif {[string length $v] > 0} {
+                set nope 0
                 html $v
+            } else {
+                html "No Title"
             }
 	}
         html {</a> }
+    } else {
+        html { <a href="http:} $env(SCRIPT_NAME) /
+        html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
+        html {No Title}
+        html {</a> }
+        html "Error: " $dispError "\n"
     }
     html "<br>\n"
 }
@@ -287,6 +304,84 @@ proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
     }
 }
 
+proc display-full-wais {zset no} {
+    set i0 0
+    set i1 0
+    set refNo 0
+    set body [$zset getWAIS $no text]
+
+    while {[string length [set c [string index $body $i1]]]} {
+        if {[string compare $c \n]} {
+            incr i1
+            continue
+        }
+        set l [string trim [string range $body $i0 $i1]]
+        egw_log debug "line=$l"
+        incr i1
+        set i0 $i1
+        if {[string compare [string index $l 0] {<}]} {
+            egw_log "xxxxxxxxxxxxxxxx"
+            continue
+        }
+        if {[set mark [string first > $l ]] < 1} {
+            egw_log "yyyyyyyyyyyyyyyy"
+            continue
+        }
+        set data [string trim [string range $l [expr $mark +1] end]]
+        incr mark -1
+        set sw [string range $l 1 $mark]
+        egw_log debug "sw=$sw"
+        egw_log debug "data=$data"
+        switch -exact $sw {
+            ti {
+                set title $data
+            }
+            dm {
+                set dateOfLastModification $data
+            }
+            ci {
+                set controlIdentifier $data
+            }
+            lc {
+                set lastChecked $data
+            }
+            by {
+                set bytes $data
+            }
+            avli {
+                set linkage $data
+            }
+            cr {
+                incr refNo
+            }
+            li {
+                set crossRef($refNo,linkage) $data
+            }
+            cp {
+                set crossRef($refNo,title) $data
+            }
+        }
+    }
+    html {Title: } {<a href="} $linkage {">} $title "</a><br>\n"
+    html {URL: } $linkage "<br>\n"
+    if {[info exists bytes]} {
+        html {Bytes: } $bytes "<br>\n"
+    }
+    if {[info exists dateOfLastModification]} {
+        html {Last modified: } $dateOfLastModification "<br>\n"
+    }
+    if {[info exists lastChecked]} {
+        html {Last checked: } $lastChecked "<br>\n"
+    }
+    html "<ul>\n"
+    for {set i 1} {$i <= $refNo} {incr i} {
+        html {<li><a href="} $crossRef($i,linkage) {">}
+        html $crossRef($i,title) "</a><br>\n"
+        html "URL: " $crossRef($i,linkage)
+    }
+    html "</ul>\n"
+}
+
 proc display-full {zset no tno} {
     set type [$zset type $no]
     if {$type == "SD"} {
@@ -305,7 +400,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
+        return
+    }
     if {[catch {set r [$zset getMarc $no line * * *]}]} {
         html "Unknown record type: $rtype <br>\n"
         return
@@ -391,7 +490,7 @@ proc display-full {zset no tno} {
         if {"x$sp" == "x"} {
             set sp $url
         }
-        html {<dd><a href="} $url {">} [join $sp] "</a>\n"
+        html {<dd><a href="} [join $url] {">} [join $sp] "</a>\n"
     }
     dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "<br>\n"
     dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "<br>\n"
@@ -443,6 +542,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] {
@@ -486,9 +594,7 @@ proc z39scan {setNo scanNo tno scanLines scanPos cache} {
         set scanAttr $hist($setNo,scanAttr)
         set scanTerm $hist($setNo,$scanNo,scanTerm)
     }
-    if {[catch [list $zz failback fail-response]]} {
-        ir $zz
-    }
+    mkAssoc $zz $host
     if {[catch [list set oldHost [$zz connect]]]} {
         set oldHost ""
     }
@@ -496,7 +602,7 @@ proc z39scan {setNo scanNo tno scanLines scanPos cache} {
     $zz callback ok-response
     $zz failback fail-response
     set thisHost [splitHostSpec $host]
-    if {$oldHost != $thisHost} {
+    if {[string compare $oldHost $thisHost]} {
         catch [list $zz disconnect]
 
         set sessionWait 0
@@ -646,16 +752,14 @@ proc z39search {setNo piggy tno elements} {
         set database $hist($setNo,database)
         set query $hist($setNo,query)
     }
-    if {[catch [list $zz failback fail-response]]} {
-        ir $zz
-    }
+    mkAssoc $zz $host
     if {[catch [list set oldHost [$zz connect]]]} {
         set oldHost ""
     }
     $zz callback ok-response
     $zz failback fail-response
     set thisHost [splitHostSpec $host]
-    if {$oldHost != $thisHost} {
+    if {[string compare $oldHost $thisHost]} {
         catch [list $zz disconnect]
 
         set sessionWait 0
@@ -680,7 +784,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
@@ -696,15 +800,23 @@ proc z39search {setNo piggy tno elements} {
             displayError "Cannot initialize target $thisHost" $u
             return 0
         }
-    } else {
-        if {[info exists hist($setNo,hits)] && \
-                ![catch [list $zz.$setNo smallSetUpperBound 0]]} {
-            return 1
+    } elseif {![catch  [list $zz.$setNo smallSetUpperBound 0]]} {
+        if {$tno > 0} {
+            if {[info exists hist($setNo,$tno,hits)]} {
+                return 1
+            }
+        } else {
+            if {[info exists hist($setNo,hits)]} {
+                return 1
+            }
         }
-        
     }
-    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 {}
     }
@@ -731,7 +843,7 @@ proc z39search {setNo piggy tno elements} {
     egw_log debug "search: $query"
     $zz.$setNo search $query
 
-    if {[catch {egw_wait sessionWait 600}]} {
+    if {[catch {egw_wait sessionWait 60}]} {
         egw_log debug "timeout/cancel in search"
         displayError "Timeout in search" {}
         html "</body></html>\n"
@@ -757,8 +869,13 @@ proc init-m-response {i} {
 
     egw_log debug "init-m-response"
 
-    set zstatus($i) 1
     incr zleft -1
+    if {![z39$i initResult]} {
+        set zstatus($i) -1
+        z39$i disconnect
+        return
+    }
+    set zstatus($i) 1
 }
 
 proc connect-m-response {i} {
@@ -790,16 +907,20 @@ proc search-m-response {setNo i start number} {
     egw_log debug "search-m-response"
     set status [z39$i.$setNo responseStatus]
     egw_log debug "search-m-response1"
-    if {[lindex $status 0] != "DBOSD"} {
+    if {[lindex $status 0] == "OK"} {
+        set nor 0
+    } elseif {[lindex $status 0] == "DBOSD"} {
+        set nor [z39$i.$setNo numberOfRecordsReturned]
+    } else {
         egw_log debug "search-m-response2"
         incr zleft -1
         set zstatus($i) 2
         return
     }
-    set nor [z39$i.$setNo numberOfRecordsReturned]
+    set hist($setNo,$i,hits) [z39$i.$setNo resultCount]
     egw_log debug "search-m-response3"
     set hist($setNo,$i,offset) [expr $start + $nor -1]
-    if {[expr $nor + $start] >= [z39$i.$setNo resultCount]} {
+    if {[expr $nor + $start] > [z39$i.$setNo resultCount]} {
         egw_log debug "search-m-response4"
         incr zleft -1
         set zstatus($i) 2
@@ -807,7 +928,7 @@ proc search-m-response {setNo i start number} {
     }
     egw_log debug "search-m-response5"
     if {$nor >= $number} {
-        egw_log debug "search-m-response6"
+        egw_log debug "search-m-response6 nor=$nor number=$number"
         incr zleft -1
         set zstatus($i) 2
         return
@@ -828,17 +949,17 @@ proc z39msearch {setNo elements start number cache} {
     global zstatus
     global hist
     global targets
+    global debug
 
     set not $hist($setNo,0,host)
 
+    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 {$oldHost != $thisHost} {
+        if {[string compare $oldHost $thisHost]} {
             catch {z39$i disconnect}
         }
         z39$i callback [list connect-m-response $i]
@@ -849,7 +970,7 @@ proc z39msearch {setNo elements start number cache} {
         set oldHost [z39$i connect]
         set host $hist($setNo,$i,host)
         set thisHost [splitHostSpec $host]
-        if {$oldHost == $thisHost} {
+        if {![string compare $oldHost $thisHost]} {
             continue
         }
         egw_log debug "old=$oldHost this=$thisHost"
@@ -868,15 +989,27 @@ proc z39msearch {setNo elements start number cache} {
     }
     set zleft 0
     for {set i 1} {$i <= $not} {incr i} {
-        html "host " [splitHostSpec $hist($setNo,$i,host)] ": "
+        set host $hist($setNo,$i,host)
+        if {$debug} {
+            html "host " [splitHostSpec $host] ": "
+        }
         egw_log debug "i=$i zstatus=$zstatus($i)"
         if {$zstatus($i) < 1} {
-            html "fail<br>\n"
+            if {$debug} {
+                html "fail<br>\n"
+            }
             continue
         }
         if {[catch [list z39$i.$setNo preferredRecordSyntax USMARC]]} {
-            html "ok<br>\n"
-            ir-set z39$i.$setNo z39$i
+            if {$debug} {
+                html "ok<br>\n"
+            }
+
+            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)
 
@@ -923,15 +1056,21 @@ proc z39msearch {setNo elements start number cache} {
             z39$i.$setNo recordElements $thisElements
 
             for {set n 0} {$n < $tnumber} {incr n} {
-                if {[z39$i.$setNo type [expr $start + $n]] == ""} {
+                if {[z39$i.$setNo recordType [expr $start + $n]] == ""} {
                     if {$n > 0} {
                         egw_log debug "failed on $n"
                     }
+                    if {$debug} {
+                        html "no record at #" [expr $start + $n]
+                        html " el=-" $thisElements "-"
+                    }
                     break
                 }
             }
             if {$n == $tnumber} {
-                html "cached<br>\n"
+                if {$debug} {
+                    html "cached<br>\n"
+                }
                 continue
             }
             
@@ -942,7 +1081,9 @@ proc z39msearch {setNo elements start number cache} {
             egw_log debug "mpresent start=$start number=$tnumber"
             z39$i.$setNo present $start $tnumber
         } else {
-            html "ok<br>\n"
+            if {$debug} {
+                html "ok<br>\n"
+            }
         }
     }
     while {$zleft > 0} {
@@ -985,7 +1126,7 @@ proc z39present {setNo tno setOffset setMax dfunc elements} {
 
     while {$setMax > 0 && $toGet > 0} {
         for {set got 0} {$got < $toGet} {incr got} {
-            if {[$zz.$setNo type [expr $setOffset + $got]] == ""} {
+            if {[$zz.$setNo recordType [expr $setOffset + $got]] == ""} {
                 break
             }
         }
@@ -1266,3 +1407,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