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.4 1998-04-02 14:32:00 adam
10 # Minor changes to EXPLAIN driver.
12 # Revision 1.3 1998/02/12 13:32:42 adam
13 # Updated configuration system.
16 # Procedure explain-search
17 # Issue search request with explain-attribute set and specific
19 proc explain-search-request {target zz category finish response fresponse} {
20 z39 callback [list explain-search-response $target $zz $category $finish \
23 $zz databaseNames IR-Explain-1
24 $zz preferredRecordSyntax explain
25 $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
28 # Procedure explain-search-response
29 # Deal with search response.
30 proc explain-search-response {target zz category finish response fresponse} {
38 set status [$zz responseStatus]
39 if {![string compare [lindex $status 0] NSD]} {
40 $fresponse $target $zz $category $finish
43 set cnt [$zz resultCount]
45 $fresponse $target $zz $category $finish
48 set rr [$zz numberOfRecordsReturned]
49 set cnt [expr $cnt - $rr]
51 explain-present-response $target $zz $category $finish \
55 z39 callback [list explain-present-response $target $zz $category $finish \
61 # Procedure explain-present-response
62 # Deal with explain present response.
63 proc explain-present-response {target zz category finish response fresponse} {
71 set cnt [$zz resultCount]
72 ir-log debug "cnt=$cnt"
73 for {set i 1} {$i <= $cnt} {incr i} {
74 if {[string compare [$zz type $i] DB]} {
75 $fresponse $target $zz $category $finish
78 if {[string compare [$zz recordType $i] Explain]} {
79 $fresponse $target $zz $category $finish
83 $response $target $zz $category $finish
87 # Procedure explain-check-0
88 # Phase 0: CategoryList
89 proc explain-check-0 {target zz category finish} {
90 show-status Explaining 1 0
91 show-message CategoryList
92 explain-search-request $target z39.categoryList CategoryList $finish \
93 explain-check-5 explain-check-fail
96 # Procedure explain-check-5
98 proc explain-check-5 {target zz category finish} {
99 show-status Explaining 1 0
100 show-message TargetInfo
102 if {![catch {set rec [z39.categoryList getExplain $no databaseInfo]}]} {
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 $finish \
115 explain-check-ok explain-check-fail
118 # Proedure explain-check-fail
119 # Deal with explain check failure - call finish handler
120 proc explain-check-fail {target zz category finish} {
121 eval $finish [list $target]
125 # Procedure explain-check-ok
126 proc explain-check-ok {target zz category finish} {
127 global profile settingsChanged
129 set trec [z39.categoryList getExplain 1 categoryList]
130 puts "--- categoryList"
133 set trec [z39.targetInfo getExplain 1 targetInfo]
134 puts "--- targetInfo"
139 if {[catch {set rec \
140 [z39.databaseInfo getExplain $no databaseInfo]}]} break
141 puts "--- databaseInfo $no"
145 set db [lindex [lindex $rec 1] 1]
146 if {![string length $db]} break
150 if {[info exists dbList]} {
151 set profile($target,databases) $dbList
155 set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
156 if {[string length $data]} {
157 set profile($target,descripton) $data
160 set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
161 set profile($target,timeLastExplain) [clock seconds]
162 set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
163 set profile($target,recentNews) [lindex [lindex $trec 2] 1]
164 set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
165 set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
166 set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
167 set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
168 set profile($target,welcomeMessage) \
169 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
171 set settingsChanged 1
173 eval $finish [list $target]
176 # Procedure explain-refresh
177 proc explain-refresh {target finish} {
178 explain-check-0 $target {} {} $finish
181 # Procedure explain-check
182 # Checks target for explain database.
183 # Evals "$finish $target" on finish.
184 proc explain-check {target finish} {
188 set time [clock seconds]
189 set etime $profile($target,timeLastExplain)
190 if {[string length $etime]} {
191 # Check last explain. If 1 day since last explain do explain egain.
193 if {$time > [expr 180 + $etime]} {
197 # Check last init. If never init or 1 week after do explain anyway.
199 set etime $profile($target,timeLastInit)
200 if {![string length $etime]} {
202 } elseif {$time > [expr 604800 + $etime]} {
207 explain-refresh $target $finish
209 eval $finish [list $target]