X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=explain.tcl;h=b827274ff5de63c17ae877ca15e2617680284495;hb=0c682ff1b331c59f85fda5a38110cce3f791a2f1;hp=9c45458f221f97ba78015bb96bad1b288d8c491f;hpb=1bf7f7dd79d70efaa29e01b2a0ba911b40547154;p=ir-tcl-moved-to-github.git

diff --git a/explain.tcl b/explain.tcl
index 9c45458..b827274 100644
--- a/explain.tcl
+++ b/explain.tcl
@@ -1,14 +1,39 @@
+# IR toolkit for tcl/tk
+# (c) Index Data 1995-1998
+# See the file LICENSE for details.
+# Sebastian Hammer, Adam Dickmeiss
+#
+# Explain Driver
+#
+# $Log: explain.tcl,v $
+# Revision 1.6  1999-11-30 14:05:58  adam
+# Updated for new location of YAZ headers.
+#
+# Revision 1.5  1998/05/20 12:27:43  adam
+# Better Explain support.
+#
+# Revision 1.4  1998/04/02 14:32:00  adam
+# Minor changes to EXPLAIN driver.
+#
+# Revision 1.3  1998/02/12 13:32:42  adam
+# Updated configuration system.
+#
 
-proc explain-search {target zz category finish response fresponse} {
-    z39 callback [list explain-search-r $target $zz $category $finish \
+# Procedure explain-search
+#  Issue search request with explain-attribute set and specific
+#  category.
+proc explain-search-request {target zz category finish response fresponse} {
+    z39 callback [list explain-search-response $target $zz $category $finish \
             $response $fresponse]
     ir-set $zz z39
     $zz databaseNames IR-Explain-1
     $zz preferredRecordSyntax explain
-    $zz search "@attrset exp1 @attr 1=1 $category"
+    $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
 }
 
-proc explain-search-r {target zz category finish response fresponse} {
+# Procedure explain-search-response
+#  Deal with search response.
+proc explain-search-response {target zz category finish response fresponse} {
     global cancelFlag
 
     apduDump
@@ -29,71 +54,130 @@ proc explain-search-r {target zz category finish response fresponse} {
     set rr [$zz numberOfRecordsReturned]
     set cnt [expr $cnt - $rr]
     if {$cnt <= 0} {
-        $response $target $zz $category $finish
+	explain-present-response $target $zz $category $finish \
+	    $response $fresponse
         return
     }
-    z39 callback [list $response $target $zz $category $finish]
+    z39 callback [list explain-present-response $target $zz $category $finish \
+		      $response $fresponse]
     incr rr
     $zz present $rr $cnt
 }
 
-proc explain-check {target finish} {
-    global profile
+# Procedure explain-present-response
+#  Deal with explain present response.
+proc explain-present-response {target zz category finish response fresponse} {
+    global cancelFlag
 
-    set time [clock seconds]
-    set etime [lindex $profile($target) 19]
-    if {[string length $etime]} {
-        # Check last explain. If 1 day since last explain do explain egain.
-        # 1 day = 86400
-        if {$time > [expr 180 + $etime]} {
-            explain-start $target $finish
-            return
-        }
-    } else {
-        # Check last init. If never init or 1 week after do explain anyway.
-        # 1 week = 604800
-        set etime [lindex $profile($target) 18]
-        if {![string length $etime]} {
-            explain-start $target $finish
-            return
-        } elseif {$time > [expr 604800 + $etime]} {
-            explain-start $target $finish
-            return
-        }
+    apduDump
+    if {$cancelFlag} {
+        close-target
+        return
     }
-    eval $finish [list $target]
+    set cnt [$zz resultCount]
+    ir-log debug "cnt=$cnt"
+    for {set i 1} {$i <= $cnt} {incr i} {
+	if {[string compare [$zz type $i] DB]} {
+	    $fresponse $target $zz $category $finish
+	    return
+	}
+	if {[string compare [$zz recordType $i] Explain]} {
+	    $fresponse $target $zz $category $finish
+	    return
+	}
+    }
+    $response $target $zz $category $finish
 }
 
-proc explain-start {target finish} {
+
+# Procedure explain-check-0
+#  Phase 0: CategoryList
+proc explain-check-0 {target zz category finish} {
     show-status Explaining 1 0
-    show-message TargetInfo
-    explain-search $target z39.targetInfo TargetInfo $finish \
-            explain-check-1 explain-check-1f
+    show-message CategoryList
+    explain-search-request $target z39.categoryList CategoryList $finish \
+            explain-check-5 explain-check-fail
 }
 
-proc explain-check-1f {target zz category finish} {
-    eval $finish [list $target]
+# Procedure explain-check-5
+#  TargetInfo
+proc explain-check-5 {target zz category finish} {
+    show-status Explaining 1 0
+    show-message TargetInfo
+
+    explain-search-request $target z39.targetInfo TargetInfo $finish \
+            explain-check-10 explain-check-fail
 }
 
-proc explain-check-1 {target zz category finish} {
+# Procedure explain-check-10
+#  DatabaseInfo
+proc explain-check-10 {target zz category finish} {
     show-status Explaining 1 0
     show-message DatabaseInfo
-    explain-search $target z39.databaseInfo DatabaseInfo $finish \
-            explain-check-2 explain-check-1f
+    explain-search-request $target z39.databaseInfo DatabaseInfo \
+	$finish explain-check-15 explain-check-fail
+}
+
+# Procedure explain-check-15
+#  AttributeDetails
+proc explain-check-15 {target zz category finish} {
+    show-status Explaining 1 0
+    show-message AttributeDetails
+    explain-search-request $target z39.attributeDetails AttributeDetails \
+	$finish explain-check-ok explain-check-ok
+}
+
+# Proedure explain-check-fail
+#  Deal with explain check failure - call finish handler
+proc explain-check-fail {target zz category finish} {
+    eval $finish [list $target]
+}
+
+proc prettyDump {x} {
+    foreach y $x {
+	prettyDumpR $y 0
+    }
+}
+
+proc prettyDumpR {x ind} {
+    for {set i 0} {$i < $ind} {incr i} {
+	puts -nonewline " "
+    }
+    set i 0
+    foreach y $x {
+	if {$i == 0} {
+	    if {![string compare $y text]} {
+		puts $x
+		return
+	    }
+	    puts $y
+	} else {
+	    prettyDumpR $y [expr $ind + 2]
+	}
+	incr i
+    }
 }
 
-proc explain-check-2 {target zz category finish} {
+# Procedure explain-check-ok
+proc explain-check-ok {target zz category finish} {
     global profile settingsChanged
 
+    set crec [z39.categoryList getExplain 1 categoryList]
+    dputs "--- categoryList"
+    dputs $crec
+
+    set rec [z39.targetInfo getExplain 1]
+
     set trec [z39.targetInfo getExplain 1 targetInfo]
-    puts "--- targetInfo"
-    puts $trec
+    dputs "--- targetInfo"
+    dputs $rec
+
     set no 1
     while {1} {
         if {[catch {set rec \
                 [z39.databaseInfo getExplain $no databaseInfo]}]} break
-        puts "--- databaseInfo $no"
-        puts $rec
+        dputs "--- databaseInfo $no"
+	dputs $rec
 
         lappend dbRecs $rec
         set db [lindex [lindex $rec 1] 1]
@@ -102,42 +186,73 @@ proc explain-check-2 {target zz category finish} {
         incr no
     }
     if {[info exists dbList]} {
-        set profile($target) [lreplace $profile($target) 7 7 $dbList]
-        set profile($target) [lreplace $profile($target) 25 25 {}]
+        set profile($target,databases) $dbList
     }
     cascade-target-list
-    
+
+
+    set no 1
+    while {1} {
+        if {[catch {set rec \
+                [z39.attributeDetails getExplain $no attributeDetails]}]} break
+        dputs "--- attributeDetails $no"
+	dputs $rec
+        incr no
+    }
     set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
     if {[string length $data]} {
-        set profile($target) [lreplace $profile($target) 0 0 $data]
-    }
-
-    set l [llength $profile($target)]
-    while {$l < 29} {
-        lappend profile($target) {}
-        incr l
+        set profile($target,descripton) $data
     }
 
-    set profile($target) [lreplace $profile($target) 8 8 \
-            [lindex [lindex $trec 4] 1]]
-    set profile($target) [lreplace $profile($target) 19 19 \
-            [clock seconds]]
-    set profile($target) [lreplace $profile($target) 20 20 \
-            [lindex [lindex $trec 1] 1]]
-    set profile($target) [lreplace $profile($target) 21 21 \
-            [lindex [lindex $trec 2] 1]]
-    set profile($target) [lreplace $profile($target) 22 22 \
-            [lindex [lindex $trec 6] 1]]
-    set profile($target) [lreplace $profile($target) 23 23 \
-            [lindex [lindex $trec 7] 1]]
-    set profile($target) [lreplace $profile($target) 24 24 \
-            [lindex [lindex $trec 8] 1]]
-    set profile($target) [lreplace $profile($target) 26 26 \
-            [lindex [lindex $trec 5] 1]]
-    set profile($target) [lreplace $profile($target) 27 27 \
-            [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]]
-
+    set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
+    set profile($target,timeLastExplain) [clock seconds]
+    set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
+    set profile($target,recentNews) [lindex [lindex $trec 2] 1]
+    set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
+    set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
+    set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
+    set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
+    set profile($target,welcomeMessage) \
+	[lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
+    
     set settingsChanged 1
 
     eval $finish [list $target]
 }
+
+# Procedure explain-refresh
+proc explain-refresh {target finish} {
+    explain-check-0 $target {} {} $finish
+}
+
+# Procedure explain-check
+#   Checks target for explain database.
+#   Evals "$finish $target" on finish.
+proc explain-check {target finish} {
+    global profile
+    
+    set refresh 0
+    set time [clock seconds]
+    set etime $profile($target,timeLastExplain)
+    if {[string length $etime]} {
+        # Check last explain. If 1 day since last explain do explain egain.
+        # 1 day = 86400
+        if {$time > [expr 180 + $etime]} {
+	    set refresh 1
+        }
+    } else {
+        # Check last init. If never init or 1 week after do explain anyway.
+        # 1 week = 604800
+        set etime $profile($target,timeLastInit)
+        if {![string length $etime]} {
+	    set refresh 1
+        } elseif {$time > [expr 604800 + $etime]} {
+	    set refresh 1
+        }
+    }
+    if {$refresh} {
+	explain-refresh $target $finish
+    } else {
+	eval $finish [list $target]
+    }
+}