1 # IR toolkit for tcl/tk
2 # (c) Index Data 1995-1998
3 # See the file LICENSE for details.
4 # Sebastian Hammer, Adam Dickmeiss
8 # $Log: explain.tcl,v $
9 # Revision 1.5 1998-05-20 12:27:43 adam
10 # Better Explain support.
12 # Revision 1.4 1998/04/02 14:32:00 adam
13 # Minor changes to EXPLAIN driver.
15 # Revision 1.3 1998/02/12 13:32:42 adam
16 # Updated configuration system.
19 # Procedure explain-search
20 # Issue search request with explain-attribute set and specific
22 proc explain-search-request {target zz category finish response fresponse} {
23 z39 callback [list explain-search-response $target $zz $category $finish \
26 $zz databaseNames IR-Explain-1
27 $zz preferredRecordSyntax explain
28 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
31 # Procedure explain-search-response
32 # Deal with search response.
33 proc explain-search-response {target zz category finish response fresponse} {
41 set status [$zz responseStatus]
42 if {![string compare [lindex $status 0] NSD]} {
43 $fresponse $target $zz $category $finish
46 set cnt [$zz resultCount]
48 $fresponse $target $zz $category $finish
51 set rr [$zz numberOfRecordsReturned]
52 set cnt [expr $cnt - $rr]
54 explain-present-response $target $zz $category $finish \
58 z39 callback [list explain-present-response $target $zz $category $finish \
64 # Procedure explain-present-response
65 # Deal with explain present response.
66 proc explain-present-response {target zz category finish response fresponse} {
74 set cnt [$zz resultCount]
75 ir-log debug "cnt=$cnt"
76 for {set i 1} {$i <= $cnt} {incr i} {
77 if {[string compare [$zz type $i] DB]} {
78 $fresponse $target $zz $category $finish
81 if {[string compare [$zz recordType $i] Explain]} {
82 $fresponse $target $zz $category $finish
86 $response $target $zz $category $finish
90 # Procedure explain-check-0
91 # Phase 0: CategoryList
92 proc explain-check-0 {target zz category finish} {
93 show-status Explaining 1 0
94 show-message CategoryList
95 explain-search-request $target z39.categoryList CategoryList $finish \
96 explain-check-5 explain-check-fail
99 # Procedure explain-check-5
101 proc explain-check-5 {target zz category finish} {
102 show-status Explaining 1 0
103 show-message TargetInfo
105 explain-search-request $target z39.targetInfo TargetInfo $finish \
106 explain-check-10 explain-check-fail
109 # Procedure explain-check-10
111 proc explain-check-10 {target zz category finish} {
112 show-status Explaining 1 0
113 show-message DatabaseInfo
114 explain-search-request $target z39.databaseInfo DatabaseInfo \
115 $finish explain-check-15 explain-check-fail
118 # Procedure explain-check-15
120 proc explain-check-15 {target zz category finish} {
121 show-status Explaining 1 0
122 show-message AttributeDetails
123 explain-search-request $target z39.attributeDetails AttributeDetails \
124 $finish explain-check-ok explain-check-ok
127 # Proedure explain-check-fail
128 # Deal with explain check failure - call finish handler
129 proc explain-check-fail {target zz category finish} {
130 eval $finish [list $target]
133 proc prettyDump {x} {
139 proc prettyDumpR {x ind} {
140 for {set i 0} {$i < $ind} {incr i} {
146 if {![string compare $y text]} {
152 prettyDumpR $y [expr $ind + 2]
158 # Procedure explain-check-ok
159 proc explain-check-ok {target zz category finish} {
160 global profile settingsChanged
166 set crec [z39.categoryList getExplain 1 categoryList]
167 puts "--- categoryList"
170 set rec [z39.targetInfo getExplain 1]
172 set trec [z39.targetInfo getExplain 1 targetInfo]
173 puts "--- targetInfo"
178 if {[catch {set rec \
179 [z39.databaseInfo getExplain $no databaseInfo]}]} break
180 puts "--- databaseInfo $no"
184 set db [lindex [lindex $rec 1] 1]
185 if {![string length $db]} break
189 if {[info exists dbList]} {
190 set profile($target,databases) $dbList
197 if {[catch {set rec \
198 [z39.attributeDetails getExplain $no attributeDetails]}]} break
199 puts "--- attributeDetails $no"
203 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
204 if {[string length $data]} {
205 set profile($target,descripton) $data
208 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
209 set profile($target,timeLastExplain) [clock seconds]
210 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
211 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
212 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
213 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
214 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
215 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
216 set profile($target,welcomeMessage) \
217 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
219 set settingsChanged 1
221 eval $finish [list $target]
224 # Procedure explain-refresh
225 proc explain-refresh {target finish} {
226 explain-check-0 $target {} {} $finish
229 # Procedure explain-check
230 # Checks target for explain database.
231 # Evals "$finish $target" on finish.
232 proc explain-check {target finish} {
236 set time [clock seconds]
237 set etime $profile($target,timeLastExplain)
238 if {[string length $etime]} {
239 # Check last explain. If 1 day since last explain do explain egain.
241 if {$time > [expr 180 + $etime]} {
245 # Check last init. If never init or 1 week after do explain anyway.
247 set etime $profile($target,timeLastInit)
248 if {![string length $etime]} {
250 } elseif {$time > [expr 604800 + $etime]} {
255 explain-refresh $target $finish
257 eval $finish [list $target]