explain.tcl

   1
   2 # Procedure explain-search
   3 #  Issue search request with explain-attribute set and specific
   4 #  category.
   5 proc explain-search-request {target zz category finish response fresponse} {
   6     z39 callback [list explain-search-response $target $zz $category $finish \
   7             $response $fresponse]
   8     ir-set $zz z39
   9     $zz databaseNames IR-Explain-1
  10     $zz preferredRecordSyntax explain
  11     $zz search "@attrset exp1 @attr 1=1 $category"
  12 }
  13
  14 # Procedure explain-search-response
  15 #  Deal with search response.
  16 proc explain-search-response {target zz category finish response fresponse} {
  17     global cancelFlag
  18
  19     apduDump
  20     if {$cancelFlag} {
  21         close-target
  22         return
  23     }
  24     set status [$zz responseStatus]
  25     if {![string compare [lindex $status 0] NSD]} {
  26         $fresponse $target $zz $category $finish
  27         return
  28     }
  29     set cnt [$zz resultCount]
  30     if {$cnt <= 0} {
  31         $fresponse $target $zz $category $finish
  32         return
  33     }
  34     set rr [$zz numberOfRecordsReturned]
  35     set cnt [expr $cnt - $rr]
  36     if {$cnt <= 0} {
  37         explain-present-response $target $zz $category $finish \
  38             $response $fresponse
  39         return
  40     }
  41     z39 callback [list explain-present-response $target $zz $category $finish \
  42                       $response $fresponse]
  43     incr rr
  44     $zz present $rr $cnt
  45 }
  46
  47 # Procedure explain-present-response
  48 #  Deal with explain present response.
  49 proc explain-present-response {target zz category finish response fresponse} {
  50     global cancelFlag
  51
  52     apduDump
  53     if {$cancelFlag} {
  54         close-target
  55         return
  56     }
  57     set cnt [$zz resultCount]
  58     ir-log debug "cnt=$cnt"
  59     for {set i 1} {$i <= $cnt} {incr i} {
  60         if {[string compare [$zz type $i] DB]} {
  61             $fresponse $target $zz $category $finish
  62             return
  63         }
  64         if {[string compare [$zz recordType $i] Explain]} {
  65             $fresponse $target $zz $category $finish
  66             return
  67         }
  68     }
  69     $response $target $zz $category $finish
  70 }
  71
  72
  73 # Procedure explain-check-0
  74 #  Phase 0: CategoryList
  75 proc explain-check-0 {target finish} {
  76     show-status Explaining 1 0
  77     show-message CategoryList
  78     explain-search-request $target z39.categoryList CategoryList $finish \
  79             explain-check-5 explain-check-fail
  80 }
  81
  82 # Procedure explain-check-5
  83 #  TargetInfo
  84 proc explain-check-5 {target zz category finish} {
  85     show-status Explaining 1 0
  86     show-message TargetInfo
  87
  88     if {![catch {set rec [z39.categoryList getExplain $no databaseInfo]}]} {
  89         dputs $rec
  90     }
  91     explain-search-request $target z39.targetInfo TargetInfo $finish \
  92             explain-check-10 explain-check-fail
  93 }
  94
  95 # Procedure explain-check-10
  96 #  DatabaseInfo
  97 proc explain-check-10 {target zz category finish} {
  98     show-status Explaining 1 0
  99     show-message DatabaseInfo
 100     explain-search-request $target z39.databaseInfo DatabaseInfo $finish \
 101             explain-check-ok explain-check-fail
 102 }
 103
 104 # Proedure explain-check-fail
 105 #  Deal with explain check failure - call finish handler
 106 proc explain-check-fail {target zz category finish} {
 107     eval $finish [list $target]
 108 }
 109
 110
 111 # Procedure explain-check-ok
 112 proc explain-check-ok {target zz category finish} {
 113     global profile settingsChanged
 114
 115     set trec [z39.categoryList getExplain 1 categoryList]
 116     puts "--- categoryList"
 117     puts $trec
 118
 119     set trec [z39.targetInfo getExplain 1 targetInfo]
 120     puts "--- targetInfo"
 121     puts $trec
 122
 123     set no 1
 124     while {1} {
 125         if {[catch {set rec \
 126                 [z39.databaseInfo getExplain $no databaseInfo]}]} break
 127         puts "--- databaseInfo $no"
 128         puts $rec
 129
 130         lappend dbRecs $rec
 131         set db [lindex [lindex $rec 1] 1]
 132         if {![string length $db]} break
 133         lappend dbList $db
 134         incr no
 135     }
 136     if {[info exists dbList]} {
 137         set profile($target,databases) $dbList
 138     }
 139     cascade-target-list
 140
 141     set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
 142     if {[string length $data]} {
 143         set profile($target,descripton) $data
 144     }
 145
 146     set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
 147     set profile($target,timeLastExplain) [clock seconds]
 148     set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
 149     set profile($target,recentNews) [lindex [lindex $trec 2] 1]
 150     set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
 151     set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
 152     set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
 153     set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
 154     set profile($target,welcomeMessage) \
 155         [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
 156
 157     set settingsChanged 1
 158
 159     eval $finish [list $target]
 160 }
 161
 162 # Procedure explain-refresh
 163 proc explain-refresh {target finish} {
 164     explain-check-0 $target $finish
 165 }
 166
 167 # Procedure explain-check
 168 #   Checks target for explain database.
 169 #   Evals "$finish $target" on finish.
 170 proc explain-check {target finish} {
 171     global profile
 172
 173     set refresh 0
 174     set time [clock seconds]
 175     set etime $profile($target,timeLastExplain)
 176     if {[string length $etime]} {
 177         # Check last explain. If 1 day since last explain do explain egain.
 178         # 1 day = 86400
 179         if {$time > [expr 180 + $etime]} {
 180             set refresh 1
 181         }
 182     } else {
 183         # Check last init. If never init or 1 week after do explain anyway.
 184         # 1 week = 604800
 185         set etime $profile($target,timeLastInit)
 186         if {![string length $etime]} {
 187             set refresh 1
 188         } elseif {$time > [expr 604800 + $etime]} {
 189             set refresh 1
 190         }
 191     }
 192     if {$refresh} {
 193         explain-refresh $target $finish
 194     } else {
 195         eval $finish [list $target]
 196     }
 197 }