5 wm title $w "Debug Window"
8 scrollbar $w.top.s -command [list $w.top.t yview]
9 text $w.top.t -width 60 -height 10 -wrap word -relief flat -borderwidth 0 \
10 -font fixed -yscroll [list $w.top.s set]
11 pack $w.top.s -side right -fill y
12 pack $w.top.t -expand yes -fill both -expand y
16 #Procedure get-attributeDetails
17 #If the target supports explain the Attribute Details are extracted here.
18 #The number 1.2.840.10003.3.1 is Bib1 and 1.2.840.10003.3.2 is Gils.
19 proc get-attributeDetails {target base} {
22 if {[info commands z39.attributeDetails] == "z39.attributeDetails"} {
23 foreach arrayname [array names profile] {
24 if {[string first $target,AttributeDetails, $arrayname ] != -1} {
25 unset profile($arrayname)
28 .debug-window.top.t insert end "Explain\n"
29 while {![catch {set rec [z39.attributeDetails getExplain $index attributeDetails]}]} {
30 set db [lindex [lindex $rec 1] 1]
31 foreach tagset [lrange [lindex $rec 2] 1 end] {
32 if {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.1"} {
33 foreach attributeType [lindex $tagset 1] {
34 if {[lindex [lindex $attributeType 0] 1] == 1} {
35 foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
36 lappend profile($target,AttributeDetails,$db,Bib1Use) [lindex [lindex [lindex $attributeValues 0] 1] 1]
44 rename z39.attributeDetails ""
46 .debug-window.top.t insert end "Ingen explain\n"
50 #Procedure change-queryInfo {target base}
51 #The queryInfo array is set according to the attributes obtained by explain.
52 proc change-queryInfo {target base} {
53 global queryInfo profile bib1
54 foreach tag $profile($target,AttributeDetails,$base,Bib1Use) {
56 lappend tempList [list $bib1($tag) 1=$tag]
59 set queryInfo [lreplace $queryInfo 2 2 $tempList]
63 # Procedure explain-search
64 # Issue search request with explain-attribute set and specific
66 proc explain-search-request {target zz category finish response fresponse} {
67 z39 callback [list explain-search-response $target $zz $category $finish \
70 $zz databaseNames IR-Explain-1
71 $zz preferredRecordSyntax explain
72 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
75 # Procedure explain-search-response
76 # Deal with search response.
77 proc explain-search-response {target zz category finish response fresponse} {
85 set status [$zz responseStatus]
86 if {![string compare [lindex $status 0] NSD]} {
87 $fresponse $target $zz $category $finish
90 set cnt [$zz resultCount]
92 $fresponse $target $zz $category $finish
95 set rr [$zz numberOfRecordsReturned]
96 set cnt [expr $cnt - $rr]
98 explain-present-response $target $zz $category $finish $response $fresponse
101 z39 callback [list explain-present-response $target $zz $category $finish \
102 $response $fresponse]
107 # Procedure explain-present-response
108 # Deal with explain present response.
109 proc explain-present-response {target zz category finish response fresponse} {
117 set cnt [$zz resultCount]
118 ir-log debug "cnt=$cnt"
119 for {set i 1} {$i <= $cnt} {incr i} {
120 if {[string compare [$zz type $i] DB]} {
121 $fresponse $target $zz $category $finish
124 if {[string compare [$zz recordType $i] Explain]} {
125 $fresponse $target $zz $category $finish
129 $response $target $zz $category $finish
133 # Procedure explain-check-0
134 # Phase 0: CategoryList
135 proc explain-check-0 {target zz category finish} {
136 show-status Explaining 1 0
137 show-message CategoryList
138 explain-search-request $target z39.categoryList CategoryList $finish \
139 explain-check-5 explain-check-fail
142 # Procedure explain-check-5
144 proc explain-check-5 {target zz category finish} {
145 show-status Explaining 1 0
146 show-message TargetInfo
148 explain-search-request $target z39.targetInfo TargetInfo $finish \
149 explain-check-10 explain-check-fail
152 # Procedure explain-check-10
154 proc explain-check-10 {target zz category finish} {
155 show-status Explaining 1 0
156 show-message DatabaseInfo
157 explain-search-request $target z39.databaseInfo DatabaseInfo \
158 $finish explain-check-15 explain-check-fail
161 # Procedure explain-check-15
163 proc explain-check-15 {target zz category finish} {
164 show-status Explaining 1 0
165 show-message AttributeDetails
166 explain-search-request $target z39.attributeDetails AttributeDetails \
167 $finish explain-check-ok explain-check-ok
170 # Proedure explain-check-fail
171 # Deal with explain check failure - call finish handler
172 proc explain-check-fail {target zz category finish} {
173 eval $finish [list $target]
176 proc prettyDump {x} {
182 proc prettyDumpR {x ind} {
183 for {set i 0} {$i < $ind} {incr i} {
189 if {![string compare $y text]} {
195 prettyDumpR $y [expr $ind + 2]
201 # Procedure explain-check-ok
202 proc explain-check-ok {target zz category finish} {
203 global profile settingsChanged currentDb
209 set crec [z39.categoryList getExplain 1 categoryList]
210 puts "--- categoryList"
213 set rec [z39.targetInfo getExplain 1]
214 set trec [z39.targetInfo getExplain 1 targetInfo]
215 puts "--- targetInfo"
221 [catch {set rec [z39.databaseInfo getExplain $no databaseInfo]}]
223 puts "--- databaseInfo $no"
226 set db [lindex [lindex $rec 1] 1]
227 if {![string length $db]} break
231 if {[info exists dbList]} {
232 set profile($target,databases) $dbList
239 [catch {set rec [z39.attributeDetails getExplain $no attributeDetails]}]
241 puts "--- attributeDetails $no"
245 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
246 if {[string length $data]} {
247 set profile($target,descripton) $data
250 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
251 set profile($target,timeLastExplain) [clock seconds]
252 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
253 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
254 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
255 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
256 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
257 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
258 set profile($target,welcomeMessage) \
259 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
261 set settingsChanged 1
262 get-attributeDetails $target $currentDb
264 eval $finish [list $target]
267 # Procedure explain-refresh
268 proc explain-refresh {target finish} {
269 explain-check-0 $target {} {} $finish
272 # Procedure explain-check
273 # Checks target for explain database.
274 # Evals "$finish $target" on finish.
275 proc explain-check {target finish base} {
279 set time [clock seconds]
280 set etime $profile($target,timeLastExplain)
281 if {[string length $etime]} {
282 # Check last explain. If 1 day since last explain do explain again.
284 if {$time > [expr 0 + $etime]} {
288 # Check last init. If never init or 1 week after do explain anyway.
290 set etime $profile($target,timeLastInit)
291 if {![string length $etime]} {
293 } elseif {$time > [expr 604800 + $etime]} {
298 explain-refresh $target $finish
300 eval $finish [list $target]