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.6 1999-11-30 14:05:58 adam
10 # Updated for new location of YAZ headers.
12 # Revision 1.5 1998/05/20 12:27:43 adam
13 # Better Explain support.
15 # Revision 1.4 1998/04/02 14:32:00 adam
16 # Minor changes to EXPLAIN driver.
18 # Revision 1.3 1998/02/12 13:32:42 adam
19 # Updated configuration system.
22 # Procedure explain-search
23 # Issue search request with explain-attribute set and specific
25 proc explain-search-request {target zz category finish response fresponse} {
26 z39 callback [list explain-search-response $target $zz $category $finish \
29 $zz databaseNames IR-Explain-1
30 $zz preferredRecordSyntax explain
31 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
34 # Procedure explain-search-response
35 # Deal with search response.
36 proc explain-search-response {target zz category finish response fresponse} {
44 set status [$zz responseStatus]
45 if {![string compare [lindex $status 0] NSD]} {
46 $fresponse $target $zz $category $finish
49 set cnt [$zz resultCount]
51 $fresponse $target $zz $category $finish
54 set rr [$zz numberOfRecordsReturned]
55 set cnt [expr $cnt - $rr]
57 explain-present-response $target $zz $category $finish \
61 z39 callback [list explain-present-response $target $zz $category $finish \
67 # Procedure explain-present-response
68 # Deal with explain present response.
69 proc explain-present-response {target zz category finish response fresponse} {
77 set cnt [$zz resultCount]
78 ir-log debug "cnt=$cnt"
79 for {set i 1} {$i <= $cnt} {incr i} {
80 if {[string compare [$zz type $i] DB]} {
81 $fresponse $target $zz $category $finish
84 if {[string compare [$zz recordType $i] Explain]} {
85 $fresponse $target $zz $category $finish
89 $response $target $zz $category $finish
93 # Procedure explain-check-0
94 # Phase 0: CategoryList
95 proc explain-check-0 {target zz category finish} {
96 show-status Explaining 1 0
97 show-message CategoryList
98 explain-search-request $target z39.categoryList CategoryList $finish \
99 explain-check-5 explain-check-fail
102 # Procedure explain-check-5
104 proc explain-check-5 {target zz category finish} {
105 show-status Explaining 1 0
106 show-message TargetInfo
108 explain-search-request $target z39.targetInfo TargetInfo $finish \
109 explain-check-10 explain-check-fail
112 # Procedure explain-check-10
114 proc explain-check-10 {target zz category finish} {
115 show-status Explaining 1 0
116 show-message DatabaseInfo
117 explain-search-request $target z39.databaseInfo DatabaseInfo \
118 $finish explain-check-15 explain-check-fail
121 # Procedure explain-check-15
123 proc explain-check-15 {target zz category finish} {
124 show-status Explaining 1 0
125 show-message AttributeDetails
126 explain-search-request $target z39.attributeDetails AttributeDetails \
127 $finish explain-check-ok explain-check-ok
130 # Proedure explain-check-fail
131 # Deal with explain check failure - call finish handler
132 proc explain-check-fail {target zz category finish} {
133 eval $finish [list $target]
136 proc prettyDump {x} {
142 proc prettyDumpR {x ind} {
143 for {set i 0} {$i < $ind} {incr i} {
149 if {![string compare $y text]} {
155 prettyDumpR $y [expr $ind + 2]
161 # Procedure explain-check-ok
162 proc explain-check-ok {target zz category finish} {
163 global profile settingsChanged
165 set crec [z39.categoryList getExplain 1 categoryList]
166 dputs "--- categoryList"
169 set rec [z39.targetInfo getExplain 1]
171 set trec [z39.targetInfo getExplain 1 targetInfo]
172 dputs "--- targetInfo"
177 if {[catch {set rec \
178 [z39.databaseInfo getExplain $no databaseInfo]}]} break
179 dputs "--- databaseInfo $no"
183 set db [lindex [lindex $rec 1] 1]
184 if {![string length $db]} break
188 if {[info exists dbList]} {
189 set profile($target,databases) $dbList
196 if {[catch {set rec \
197 [z39.attributeDetails getExplain $no attributeDetails]}]} break
198 dputs "--- attributeDetails $no"
202 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
203 if {[string length $data]} {
204 set profile($target,descripton) $data
207 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
208 set profile($target,timeLastExplain) [clock seconds]
209 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
210 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
211 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
212 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
213 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
214 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
215 set profile($target,welcomeMessage) \
216 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
218 set settingsChanged 1
220 eval $finish [list $target]
223 # Procedure explain-refresh
224 proc explain-refresh {target finish} {
225 explain-check-0 $target {} {} $finish
228 # Procedure explain-check
229 # Checks target for explain database.
230 # Evals "$finish $target" on finish.
231 proc explain-check {target finish} {
235 set time [clock seconds]
236 set etime $profile($target,timeLastExplain)
237 if {[string length $etime]} {
238 # Check last explain. If 1 day since last explain do explain egain.
240 if {$time > [expr 180 + $etime]} {
244 # Check last init. If never init or 1 week after do explain anyway.
246 set etime $profile($target,timeLastInit)
247 if {![string length $etime]} {
249 } elseif {$time > [expr 604800 + $etime]} {
254 explain-refresh $target $finish
256 eval $finish [list $target]