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 1.2.840.10003.3.5 is Gils.
4 proc get-attributeDetails {target base} {
7 if {[info commands z39.attributeDetails] == "z39.attributeDetails"} {
8 foreach arrayname [array names profile] {
9 if {[string first $target,AttributeDetails, $arrayname ] != -1} {
10 unset profile($arrayname)
13 .debug-window.top.t insert end "Explain\n"
14 while {![catch {set rec [z39.attributeDetails getExplain $index attributeDetails]}]} {
15 set db [lindex [lindex $rec 1] 1]
16 foreach tagset [lrange [lindex $rec 2] 1 end] {
17 if {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.1"} {
18 foreach attributeType [lindex $tagset 1] {
19 if {[lindex [lindex $attributeType 0] 1] == 1} {
20 foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
21 lappend profile($target,AttributeDetails,$db,Bib1Use) [lindex [lindex [lindex $attributeValues 0] 1] 1]
25 } elseif {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.5"} {
26 # .debug-window.top.t insert end Gils\n
27 foreach attributeType [lindex $tagset 1] {
28 # .debug-window.top.t insert end [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) [lindex [lindex [lindex $attributeValues 0] 1] 1]
32 # .debug-window.top.t insert end [lindex [lindex [lindex $attributeValues 0] 1] 1]\n
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 bib1
50 foreach tag $profile($target,AttributeDetails,$base,Bib1Use) {
52 lappend tempList [list $bib1($tag) 1=$tag]
55 set queryInfo [lreplace $queryInfo 2 2 $tempList]
59 # Procedure explain-search
60 # Issue search request with explain-attribute set and specific
62 proc explain-search-request {target zz category finish response fresponse} {
63 z39 callback [list explain-search-response $target $zz $category $finish \
66 $zz databaseNames IR-Explain-1
67 $zz preferredRecordSyntax explain
68 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
71 # Procedure explain-search-response
72 # Deal with search response.
73 proc explain-search-response {target zz category finish response fresponse} {
81 set status [$zz responseStatus]
82 if {![string compare [lindex $status 0] NSD]} {
83 $fresponse $target $zz $category $finish
86 set cnt [$zz resultCount]
88 $fresponse $target $zz $category $finish
91 set rr [$zz numberOfRecordsReturned]
92 set cnt [expr $cnt - $rr]
94 explain-present-response $target $zz $category $finish $response $fresponse
97 z39 callback [list explain-present-response $target $zz $category $finish \
103 # Procedure explain-present-response
104 # Deal with explain present response.
105 proc explain-present-response {target zz category finish response fresponse} {
113 set cnt [$zz resultCount]
114 ir-log debug "cnt=$cnt"
115 for {set i 1} {$i <= $cnt} {incr i} {
116 if {[string compare [$zz type $i] DB]} {
117 $fresponse $target $zz $category $finish
120 if {[string compare [$zz recordType $i] Explain]} {
121 $fresponse $target $zz $category $finish
125 $response $target $zz $category $finish
129 # Procedure explain-check-0
130 # Phase 0: CategoryList
131 proc explain-check-0 {target zz category finish} {
132 show-status Explaining 1 0
133 show-message CategoryList
134 explain-search-request $target z39.categoryList CategoryList $finish \
135 explain-check-5 explain-check-fail
138 # Procedure explain-check-5
140 proc explain-check-5 {target zz category finish} {
141 show-status Explaining 1 0
142 show-message TargetInfo
144 explain-search-request $target z39.targetInfo TargetInfo $finish \
145 explain-check-10 explain-check-fail
148 # Procedure explain-check-10
150 proc explain-check-10 {target zz category finish} {
151 show-status Explaining 1 0
152 show-message DatabaseInfo
153 explain-search-request $target z39.databaseInfo DatabaseInfo \
154 $finish explain-check-15 explain-check-fail
157 # Procedure explain-check-15
159 proc explain-check-15 {target zz category finish} {
160 show-status Explaining 1 0
161 show-message AttributeDetails
162 explain-search-request $target z39.attributeDetails AttributeDetails \
163 $finish explain-check-ok explain-check-ok
166 # Proedure explain-check-fail
167 # Deal with explain check failure - call finish handler
168 proc explain-check-fail {target zz category finish} {
169 eval $finish [list $target]
172 proc prettyDump {x} {
178 proc prettyDumpR {x ind} {
179 for {set i 0} {$i < $ind} {incr i} {
185 if {![string compare $y text]} {
191 prettyDumpR $y [expr $ind + 2]
197 # Procedure explain-check-ok
198 proc explain-check-ok {target zz category finish} {
199 global profile settingsChanged currentDb
205 set crec [z39.categoryList getExplain 1 categoryList]
206 puts "--- categoryList"
209 set rec [z39.targetInfo getExplain 1]
210 set trec [z39.targetInfo getExplain 1 targetInfo]
211 puts "--- targetInfo"
217 [catch {set rec [z39.databaseInfo getExplain $no databaseInfo]}]
219 puts "--- databaseInfo $no"
222 set db [lindex [lindex $rec 1] 1]
223 if {![string length $db]} break
227 if {[info exists dbList]} {
228 set profile($target,databases) $dbList
235 [catch {set rec [z39.attributeDetails getExplain $no attributeDetails]}]
237 puts "--- attributeDetails $no"
241 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
242 if {[string length $data]} {
243 set profile($target,descripton) $data
246 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
247 set profile($target,timeLastExplain) [clock seconds]
248 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
249 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
250 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
251 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
252 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
253 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
254 set profile($target,welcomeMessage) \
255 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
257 set settingsChanged 1
258 get-attributeDetails $target $currentDb
260 eval $finish [list $target]
263 # Procedure explain-refresh
264 proc explain-refresh {target finish} {
265 explain-check-0 $target {} {} $finish
268 # Procedure explain-check
269 # Checks target for explain database.
270 # Evals "$finish $target" on finish.
271 proc explain-check {target finish base} {
275 set time [clock seconds]
276 set etime $profile($target,timeLastExplain)
277 if {[string length $etime]} {
278 # Check last explain. If 1 day since last explain do explain again.
280 if {$time > [expr 0 + $etime]} {
284 # Check last init. If never init or 1 week after do explain anyway.
286 set etime $profile($target,timeLastInit)
287 if {![string length $etime]} {
289 } elseif {$time > [expr 604800 + $etime]} {
294 explain-refresh $target $finish
296 eval $finish [list $target]