1 #Procedure get-attributeDetails
2 #If the target supports explain the Attribute Details are extracted here.
3 #The number 1.2.840.10003.3.1 is Bib1, 1.2.840.10003.3.2 is Explain and
4 #1.2.840.10003.3.5 is Gils.
5 proc get-attributeDetails {target base} {
8 if {[info commands z39.attributeDetails] == "z39.attributeDetails"} {
9 foreach arrayname [array names profile] {
10 if {[string first $target,AttributeDetails, $arrayname ] != -1} {
11 unset profile($arrayname)
14 debug-window "Explain"
15 while {![catch {set rec [z39.attributeDetails getExplain $index attributeDetails]}]} {
16 set db [lindex [lindex $rec 1] 1]
17 foreach tagset [lrange [lindex $rec 2] 1 end] {
18 if {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.1"} {
19 foreach attributeType [lindex $tagset 1] {
20 if {[lindex [lindex $attributeType 0] 1] == 1} {
21 foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
22 lappend profile($target,AttributeDetails,$db,Bib1) \
23 [lindex [lindex [lindex $attributeValues 0] 1] 1]
27 } elseif {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.5"} {
28 foreach attributeType [lindex $tagset 1] {
29 if {[lindex [lindex $attributeType 0] 1] == 1} {
30 foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
31 lappend profile($target,AttributeDetails,$db,Gils) \
32 [lindex [lindex [lindex $attributeValues 0] 1] 1]
40 rename z39.attributeDetails ""
42 .debug-window.top.t insert end "Ingen explain\n"
46 #Procedure change-queryInfo {target base}
47 #The queryInfo array is set according to the attributes obtained by explain.
48 proc change-queryInfo {target base} {
49 global queryInfo profile attributeTypeSelected queryTypes
50 global queryInfo$attributeTypeSelected
51 set n [lsearch $queryTypes Auto]
52 foreach tag $profile($target,AttributeDetails,$base,$attributeTypeSelected) {
54 # lappend tempList [list $bib1($tag) 1=$tag]
56 # lappend tempList [list $gils($tag) 1=$tag]
57 set ats [string tolower $attributeTypeSelected]
60 lappend tempList [list "[set ${ats}($tag)]" 1=$tag]
62 set queryInfo$attributeTypeSelected [lreplace [set queryInfo$attributeTypeSelected] $n $n $tempList]
66 # Procedure explain-search
67 # Issue search request with explain-attribute set and specific category.
68 proc explain-search-request {target zz category finish response fresponse} {
69 z39 callback [list explain-search-response $target $zz $category $finish \
72 $zz databaseNames IR-Explain-1
73 $zz preferredRecordSyntax explain
74 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
77 # Procedure explain-search-response
78 # Deal with search response.
79 proc explain-search-response {target zz category finish response fresponse} {
87 set status [$zz responseStatus]
88 if {![string compare [lindex $status 0] NSD]} {
89 $fresponse $target $zz $category $finish
92 set cnt [$zz resultCount]
94 $fresponse $target $zz $category $finish
97 set rr [$zz numberOfRecordsReturned]
98 set cnt [expr $cnt - $rr]
100 explain-present-response $target $zz $category $finish $response $fresponse
103 z39 callback [list explain-present-response $target $zz $category $finish \
104 $response $fresponse]
109 # Procedure explain-present-response
110 # Deal with explain present response.
111 proc explain-present-response {target zz category finish response fresponse} {
119 set cnt [$zz resultCount]
120 ir-log debug "cnt=$cnt"
121 for {set i 1} {$i <= $cnt} {incr i} {
122 if {[string compare [$zz type $i] DB]} {
123 $fresponse $target $zz $category $finish
126 if {[string compare [$zz recordType $i] Explain]} {
127 $fresponse $target $zz $category $finish
131 $response $target $zz $category $finish
135 # Procedure explain-check-0
136 # Phase 0: CategoryList
137 proc explain-check-0 {target zz category finish} {
138 show-status Explaining 1 0
139 show-message CategoryList
140 explain-search-request $target z39.categoryList CategoryList $finish \
141 explain-check-5 explain-check-fail
144 # Procedure explain-check-5
146 proc explain-check-5 {target zz category finish} {
147 show-status Explaining 1 0
148 show-message TargetInfo
150 explain-search-request $target z39.targetInfo TargetInfo $finish \
151 explain-check-10 explain-check-fail
154 # Procedure explain-check-10
156 proc explain-check-10 {target zz category finish} {
157 show-status Explaining 1 0
158 show-message DatabaseInfo
159 explain-search-request $target z39.databaseInfo DatabaseInfo \
160 $finish explain-check-15 explain-check-fail
163 # Procedure explain-check-15
165 proc explain-check-15 {target zz category finish} {
166 show-status Explaining 1 0
167 show-message AttributeDetails
168 explain-search-request $target z39.attributeDetails AttributeDetails \
169 $finish explain-check-ok explain-check-ok
172 # Proedure explain-check-fail
173 # Deal with explain check failure - call finish handler
174 proc explain-check-fail {target zz category finish} {
175 eval $finish [list $target]
184 proc prettyDumpR {x ind} {
185 for {set i 0} {$i < $ind} {incr i} {
191 if {![string compare $y text]} {
197 prettyDumpR $y [expr $ind + 2]
203 # Procedure explain-check-ok
204 proc explain-check-ok {target zz category finish} {
205 global profile settingsChanged currentDb
211 set crec [z39.categoryList getExplain 1 categoryList]
212 # puts "--- categoryList"
215 set rec [z39.targetInfo getExplain 1]
216 set trec [z39.targetInfo getExplain 1 targetInfo]
217 # puts "--- targetInfo"
223 [catch {set rec [z39.databaseInfo getExplain $no databaseInfo]}]
225 # puts "--- databaseInfo $no"
228 set db [lindex [lindex $rec 1] 1]
229 if {![string length $db]} break
230 #Here the explain database IR-Explain-1 is skipped from the database list.
231 if {$db != "IR-Explain-1"} {
234 debug-window "${no}: $db"
237 if {[info exists dbList]} {
238 set profile($target,databases) $dbList
241 cascade-dblist $target 1
246 [catch {set rec [z39.attributeDetails getExplain $no attributeDetails]}]
248 # puts "--- attributeDetails $no"
252 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
253 if {[string length $data]} {
254 set profile($target,descripton) $data
257 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
258 set profile($target,timeLastExplain) [clock seconds]
259 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
260 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
261 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
262 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
263 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
264 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
265 set profile($target,welcomeMessage) \
266 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
268 set settingsChanged 1
269 get-attributeDetails $target $currentDb
271 eval $finish [list $target]
274 # Procedure explain-refresh
275 proc explain-refresh {target finish} {
276 explain-check-0 $target {} {} $finish
279 # Procedure explain-check
280 # Checks target for explain database.
281 # Evals "$finish $target" on finish.
282 proc explain-check {target finish base} {
286 set time [clock seconds]
287 set etime $profile($target,timeLastExplain)
288 if {[string length $etime]} {
289 # Check last explain. If 1 day since last explain do explain again.
291 if {$time > [expr 0 + $etime]} {
295 # Check last init. If never init or 1 week after do explain anyway.
297 set etime $profile($target,timeLastInit)
298 if {![string length $etime]} {
300 } elseif {$time > [expr 604800 + $etime]} {
305 explain-refresh $target $finish
307 eval $finish [list $target]