X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=client2%2Fexplain.tcl;h=46778ab34a54013ece86cd2a1ef685f4cd66cb4c;hb=d026c3e06f6e19e5ed4174ab1a504a4b5af79183;hp=fcf2455b82253228ff1b2547645fcbb3581db6f8;hpb=28500a1e0369e989973f214e839039e9f9e38622;p=ir-tcl-moved-to-github.git

diff --git a/client2/explain.tcl b/client2/explain.tcl
index fcf2455..46778ab 100644
--- a/client2/explain.tcl
+++ b/client2/explain.tcl
@@ -1,21 +1,7 @@
-proc debug-window {} {
-	set w .debug-window
-    toplevel $w
-
-    wm title $w "Debug Window" 
-    
-    top-down-window $w
-	scrollbar $w.top.s -command [list $w.top.t yview]
-    text $w.top.t -width 60 -height 10 -wrap word -relief flat -borderwidth 0 \
-        -font fixed -yscroll [list $w.top.s set]
-    pack $w.top.s -side right -fill y
-    pack $w.top.t -expand yes -fill both -expand y
-}
-debug-window
-
 #Procedure get-attributeDetails
 #If the target supports explain the Attribute Details are extracted here.
-#The number 1.2.840.10003.3.1 is Bib1 and 1.2.840.10003.3.2 is Gils.
+#The number 1.2.840.10003.3.1 is Bib1, 1.2.840.10003.3.2 is Explain and 
+#1.2.840.10003.3.5 is Gils.
 proc get-attributeDetails {target base} {
 	global profile
 	set index 1
@@ -25,15 +11,34 @@ proc get-attributeDetails {target base} {
 				unset profile($arrayname)
 			}
 		}
-		.debug-window.top.t insert end "Explain\n"
+		debug-window "Explain"
 		while {![catch {set rec [z39.attributeDetails getExplain $index attributeDetails]}]} {
 			set db [lindex [lindex $rec 1] 1]
 			foreach tagset [lrange [lindex $rec 2] 1 end] {
 				if {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.1"} {
+				    source bib1.tcl
+					foreach attributeType [lindex $tagset 1] {
+						if {[lindex [lindex $attributeType 0] 1] == 1} {
+							foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
+							    set attribute [lindex [lindex [lindex $attributeValues 0] 1] 1]
+							    if {[lsearch [array names bib1] $attribute] != -1} {
+								    lappend profile($target,AttributeDetails,$db,Bib1) \
+									    $attribute
+							    }
+							}
+						}						
+					}
+				} elseif {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.5"} {
+				    source gils.tcl
 					foreach attributeType [lindex $tagset 1] {
 						if {[lindex [lindex $attributeType 0] 1] == 1} {
+						    source gils.tcl
 							foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
-								lappend profile($target,AttributeDetails,$db,Bib1Use) [lindex [lindex [lindex $attributeValues 0] 1] 1]
+							    set attribute [lindex [lindex [lindex $attributeValues 0] 1] 1]
+							    if {[lsearch [array names gils] $attribute] != -1} {
+								    lappend profile($target,AttributeDetails,$db,Gils) \
+									$attribute
+							    }
 							}
 						}						
 					}
@@ -50,26 +55,36 @@ proc get-attributeDetails {target base} {
 #Procedure change-queryInfo {target base}
 #The queryInfo array is set according to the attributes obtained by explain.
 proc change-queryInfo {target base} {
-	global queryInfo profile bib1
-	foreach tag $profile($target,AttributeDetails,$base,Bib1Use) {
-		if {$tag < 1037} {
-			lappend tempList [list $bib1($tag) 1=$tag]
-		}
-	}
-	set queryInfo [lreplace $queryInfo 2 2 $tempList]
+	global queryInfo profile attributeTypeSelected queryTypes
+	global queryInfo$attributeTypeSelected
+	set n [lsearch $queryTypes Auto]
+	set ats [string tolower $attributeTypeSelected]
+    global $ats
+    source ${ats}.tcl
+	foreach tag $profile($target,AttributeDetails,$base,$attributeTypeSelected) {
+#        if {$tag < 2000} 
+#            lappend tempList [list $bib1($tag) 1=$tag]
+#         else 
+#            lappend tempList [list $gils($tag) 1=$tag]
+#        set ats [string tolower $attributeTypeSelected]
+#        global $ats
+#        source ${ats}.tcl
+        lappend tempList [list "[set ${ats}($tag)]" 1=$tag]    
+    }
+	set queryInfo$attributeTypeSelected [lreplace [set queryInfo$attributeTypeSelected] $n $n $tempList]
 }
 
 
 # Procedure explain-search
-#  Issue search request with explain-attribute set and specific
-#  category.
+# 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]
+        $response $fresponse]
     ir-set $zz z39
     $zz databaseNames IR-Explain-1
     $zz preferredRecordSyntax explain
     $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
+#    $zz search "@attrset exp1 @attr 1=1 $category"
 }
 
 # Procedure explain-search-response
@@ -173,73 +188,48 @@ 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
-    }
-}
 
 # Procedure explain-check-ok
 proc explain-check-ok {target zz category finish} {
-    global profile settingsChanged
+    global profile settingsChanged currentDb queryAuto
 
-    puts ""
-    puts ""
-    puts ""
-    puts ""
     set crec [z39.categoryList getExplain 1 categoryList]
-    puts "--- categoryList"
-    puts $crec
-
     set rec [z39.targetInfo getExplain 1]
     set trec [z39.targetInfo getExplain 1 targetInfo]
-    puts "--- targetInfo"
-    puts $rec
-
     set no 1
     while {1} {
         if {
         	[catch {set rec [z39.databaseInfo getExplain $no databaseInfo]}]
         } break
-    	puts "--- databaseInfo $no"
-		puts $rec
+
     	lappend dbRecs $rec
     	set db [lindex [lindex $rec 1] 1]
 		if {![string length $db]} break
-    	lappend dbList $db
+		#Here the explain database IR-Explain-1 is skipped from the database list.
+		if {$db != "IR-Explain-1"} {
+    	    lappend dbList $db
+    	}
+#    	debug-window "${no}: $db"
     	incr no
     }
     if {[info exists dbList]} {
         set profile($target,databases) $dbList
     }
+    set queryAuto 1
+    set currentDb [lindex $dbList 0]
+    z39 databaseNames $currentDb
+    show-target $target $currentDb
+    if {[lindex $finish 1] == ""} {
+        set finish [list [lindex $finish 0] $currentDb]
+    }
     cascade-target-list
+    cascade-dblist $target 1
 
     set no 1
     while {1} {
         if {
         	[catch {set rec [z39.attributeDetails getExplain $no attributeDetails]}]
 		} break
-        puts "--- attributeDetails $no"
-		puts $rec
         incr no
     }
     set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
@@ -259,6 +249,7 @@ proc explain-check-ok {target zz category finish} {
 		[lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
     
     set settingsChanged 1
+    get-attributeDetails $target $currentDb
 
     eval $finish [list $target]
 }
@@ -279,8 +270,8 @@ proc explain-check {target finish base} {
     set etime $profile($target,timeLastExplain)
     if {[string length $etime]} {
         # Check last explain. If 1 day since last explain do explain again.
-        # 1 day = 86400
-        if {$time > [expr 0 + $etime]} {
+        # 30 days = 2592000 sec.
+        if {$time > [expr 2592000 + $etime]} {
 	    	set refresh 1
         }
     } else {
@@ -295,7 +286,6 @@ proc explain-check {target finish base} {
     }
     if {$refresh} {
 		explain-refresh $target $finish
-#		get-attributeDetails $target $base
     } else {
 		eval $finish [list $target]
     }