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"} {
20 foreach attributeType [lindex $tagset 1] {
21 if {[lindex [lindex $attributeType 0] 1] == 1} {
22 foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
23 set attribute [lindex [lindex [lindex $attributeValues 0] 1] 1]
24 if {[lsearch [array names bib1] $attribute] != -1} {
25 lappend profile($target,AttributeDetails,$db,Bib1) \
31 } elseif {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.5"} {
33 foreach attributeType [lindex $tagset 1] {
34 if {[lindex [lindex $attributeType 0] 1] == 1} {
36 foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
37 set attribute [lindex [lindex [lindex $attributeValues 0] 1] 1]
38 if {[lsearch [array names gils] $attribute] != -1} {
39 lappend profile($target,AttributeDetails,$db,Gils) \
49 rename z39.attributeDetails ""
51 .debug-window.top.t insert end "Ingen explain\n"
55 #Procedure change-queryInfo {target base}
56 #The queryInfo array is set according to the attributes obtained by explain.
57 proc change-queryInfo {target base} {
58 global queryInfo profile attributeTypeSelected queryTypes
59 global queryInfo$attributeTypeSelected
60 set n [lsearch $queryTypes Auto]
61 set ats [string tolower $attributeTypeSelected]
64 foreach tag $profile($target,AttributeDetails,$base,$attributeTypeSelected) {
66 # lappend tempList [list $bib1($tag) 1=$tag]
68 # lappend tempList [list $gils($tag) 1=$tag]
69 # set ats [string tolower $attributeTypeSelected]
72 lappend tempList [list "[set ${ats}($tag)]" 1=$tag]
74 set queryInfo$attributeTypeSelected [lreplace [set queryInfo$attributeTypeSelected] $n $n $tempList]
78 # Procedure explain-search
79 # Issue search request with explain-attribute set and specific category.
80 proc explain-search-request {target zz category finish response fresponse} {
81 z39 callback [list explain-search-response $target $zz $category $finish \
84 $zz databaseNames IR-Explain-1
85 $zz preferredRecordSyntax explain
86 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
87 # $zz search "@attrset exp1 @attr 1=1 $category"
90 # Procedure explain-search-response
91 # Deal with search response.
92 proc explain-search-response {target zz category finish response fresponse} {
100 set status [$zz responseStatus]
101 if {![string compare [lindex $status 0] NSD]} {
102 $fresponse $target $zz $category $finish
105 set cnt [$zz resultCount]
107 $fresponse $target $zz $category $finish
110 set rr [$zz numberOfRecordsReturned]
111 set cnt [expr $cnt - $rr]
113 explain-present-response $target $zz $category $finish $response $fresponse
116 z39 callback [list explain-present-response $target $zz $category $finish \
117 $response $fresponse]
122 # Procedure explain-present-response
123 # Deal with explain present response.
124 proc explain-present-response {target zz category finish response fresponse} {
132 set cnt [$zz resultCount]
133 ir-log debug "cnt=$cnt"
134 for {set i 1} {$i <= $cnt} {incr i} {
135 if {[string compare [$zz type $i] DB]} {
136 $fresponse $target $zz $category $finish
139 if {[string compare [$zz recordType $i] Explain]} {
140 $fresponse $target $zz $category $finish
144 $response $target $zz $category $finish
148 # Procedure explain-check-0
149 # Phase 0: CategoryList
150 proc explain-check-0 {target zz category finish} {
151 show-status Explaining 1 0
152 show-message CategoryList
153 explain-search-request $target z39.categoryList CategoryList $finish \
154 explain-check-5 explain-check-fail
157 # Procedure explain-check-5
159 proc explain-check-5 {target zz category finish} {
160 show-status Explaining 1 0
161 show-message TargetInfo
163 explain-search-request $target z39.targetInfo TargetInfo $finish \
164 explain-check-10 explain-check-fail
167 # Procedure explain-check-10
169 proc explain-check-10 {target zz category finish} {
170 show-status Explaining 1 0
171 show-message DatabaseInfo
172 explain-search-request $target z39.databaseInfo DatabaseInfo \
173 $finish explain-check-15 explain-check-fail
176 # Procedure explain-check-15
178 proc explain-check-15 {target zz category finish} {
179 show-status Explaining 1 0
180 show-message AttributeDetails
181 explain-search-request $target z39.attributeDetails AttributeDetails \
182 $finish explain-check-ok explain-check-ok
185 # Proedure explain-check-fail
186 # Deal with explain check failure - call finish handler
187 proc explain-check-fail {target zz category finish} {
188 eval $finish [list $target]
192 # Procedure explain-check-ok
193 proc explain-check-ok {target zz category finish} {
194 global profile settingsChanged currentDb queryAuto
196 set crec [z39.categoryList getExplain 1 categoryList]
197 set rec [z39.targetInfo getExplain 1]
198 set trec [z39.targetInfo getExplain 1 targetInfo]
202 [catch {set rec [z39.databaseInfo getExplain $no databaseInfo]}]
206 set db [lindex [lindex $rec 1] 1]
207 if {![string length $db]} break
208 #Here the explain database IR-Explain-1 is skipped from the database list.
209 if {$db != "IR-Explain-1"} {
212 # debug-window "${no}: $db"
215 if {[info exists dbList]} {
216 set profile($target,databases) $dbList
219 set currentDb [lindex $dbList 0]
220 z39 databaseNames $currentDb
221 show-target $target $currentDb
222 if {[lindex $finish 1] == ""} {
223 set finish [list [lindex $finish 0] $currentDb]
226 cascade-dblist $target 1
231 [catch {set rec [z39.attributeDetails getExplain $no attributeDetails]}]
235 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
236 if {[string length $data]} {
237 set profile($target,descripton) $data
240 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
241 set profile($target,timeLastExplain) [clock seconds]
242 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
243 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
244 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
245 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
246 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
247 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
248 set profile($target,welcomeMessage) \
249 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
251 set settingsChanged 1
252 get-attributeDetails $target $currentDb
254 eval $finish [list $target]
257 # Procedure explain-refresh
258 proc explain-refresh {target finish} {
259 explain-check-0 $target {} {} $finish
262 # Procedure explain-check
263 # Checks target for explain database.
264 # Evals "$finish $target" on finish.
265 proc explain-check {target finish base} {
269 set time [clock seconds]
270 set etime $profile($target,timeLastExplain)
271 if {[string length $etime]} {
272 # Check last explain. If 1 day since last explain do explain again.
273 # 30 days = 2592000 sec.
274 if {$time > [expr 2592000 + $etime]} {
278 # Check last init. If never init or 1 week after do explain anyway.
280 set etime $profile($target,timeLastInit)
281 if {![string length $etime]} {
283 } elseif {$time > [expr 604800 + $etime]} {
288 explain-refresh $target $finish
290 eval $finish [list $target]