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.3 1998-02-12 13:32:42 adam
10 # Updated configuration system.
13 # Procedure explain-search
14 # Issue search request with explain-attribute set and specific
16 proc explain-search-request {target zz category finish response fresponse} {
17 z39 callback [list explain-search-response $target $zz $category $finish \
20 $zz databaseNames IR-Explain-1
21 $zz preferredRecordSyntax explain
22 $zz search "@attrset exp1 @attr 1=1 $category"
25 # Procedure explain-search-response
26 # Deal with search response.
27 proc explain-search-response {target zz category finish response fresponse} {
35 set status [$zz responseStatus]
36 if {![string compare [lindex $status 0] NSD]} {
37 $fresponse $target $zz $category $finish
40 set cnt [$zz resultCount]
42 $fresponse $target $zz $category $finish
45 set rr [$zz numberOfRecordsReturned]
46 set cnt [expr $cnt - $rr]
48 explain-present-response $target $zz $category $finish \
52 z39 callback [list explain-present-response $target $zz $category $finish \
58 # Procedure explain-present-response
59 # Deal with explain present response.
60 proc explain-present-response {target zz category finish response fresponse} {
68 set cnt [$zz resultCount]
69 ir-log debug "cnt=$cnt"
70 for {set i 1} {$i <= $cnt} {incr i} {
71 if {[string compare [$zz type $i] DB]} {
72 $fresponse $target $zz $category $finish
75 if {[string compare [$zz recordType $i] Explain]} {
76 $fresponse $target $zz $category $finish
80 $response $target $zz $category $finish
84 # Procedure explain-check-0
85 # Phase 0: CategoryList
86 proc explain-check-0 {target finish} {
87 show-status Explaining 1 0
88 show-message CategoryList
89 explain-search-request $target z39.categoryList TargetInfo $finish \
90 explain-check-5 explain-check-fail
93 # Procedure explain-check-5
95 proc explain-check-5 {target zz category finish} {
96 show-status Explaining 1 0
97 show-message TargetInfo
99 if {![catch {set rec [z39.categoryList getExplain $no databaseInfo]}]} {
102 explain-search-request $target z39.targetInfo TargetInfo $finish \
103 explain-check-10 explain-check-fail
106 # Procedure explain-check-10
108 proc explain-check-10 {target zz category finish} {
109 show-status Explaining 1 0
110 show-message DatabaseInfo
111 explain-search-request $target z39.databaseInfo DatabaseInfo $finish \
112 explain-check-ok explain-check-fail
115 # Proedure explain-check-fail
116 # Deal with explain check failure - call finish handler
117 proc explain-check-fail {target zz category finish} {
118 eval $finish [list $target]
122 # Procedure explain-check-ok
123 proc explain-check-ok {target zz category finish} {
124 global profile settingsChanged
126 set trec [z39.categoryList getExplain 1 categoryList]
127 puts "--- categoryList"
130 set trec [z39.targetInfo getExplain 1 targetInfo]
131 puts "--- targetInfo"
136 if {[catch {set rec \
137 [z39.databaseInfo getExplain $no databaseInfo]}]} break
138 puts "--- databaseInfo $no"
142 set db [lindex [lindex $rec 1] 1]
143 if {![string length $db]} break
147 if {[info exists dbList]} {
148 set profile($target,databases) $dbList
152 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
153 if {[string length $data]} {
154 set profile($target,descripton) $data
157 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
158 set profile($target,timeLastExplain) [clock seconds]
159 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
160 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
161 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
162 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
163 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
164 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
165 set profile($target,welcomeMessage) \
166 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
168 set settingsChanged 1
170 eval $finish [list $target]
173 # Procedure explain-refresh
174 proc explain-refresh {target finish} {
175 explain-check-0 $target $finish
178 # Procedure explain-check
179 # Checks target for explain database.
180 # Evals "$finish $target" on finish.
181 proc explain-check {target finish} {
185 set time [clock seconds]
186 set etime $profile($target,timeLastExplain)
187 if {[string length $etime]} {
188 # Check last explain. If 1 day since last explain do explain egain.
190 if {$time > [expr 180 + $etime]} {
194 # Check last init. If never init or 1 week after do explain anyway.
196 set etime $profile($target,timeLastInit)
197 if {![string length $etime]} {
199 } elseif {$time > [expr 604800 + $etime]} {
204 explain-refresh $target $finish
206 eval $finish [list $target]