client2/explain.tcl

   1 #Procedure get-attributeDetails
   2 #If the target supports explain the Attribute Details are extracted here.
   3 #The number 1.2.840.10003.3.1 is Bib1, 1.2.840.10003.3.2 is Explain and 1.2.840.10003.3.5 is Gils.
   4 proc get-attributeDetails {target base} {
   5         global profile
   6         set index 1
   7         if {[info commands z39.attributeDetails] == "z39.attributeDetails"} {
   8                 foreach arrayname [array names profile] {
   9                         if {[string first $target,AttributeDetails, $arrayname ] != -1} {
  10                                 unset profile($arrayname)
  11                         }
  12                 }
  13                 .debug-window.top.t insert end "Explain\n"
  14                 while {![catch {set rec [z39.attributeDetails getExplain $index attributeDetails]}]} {
  15                         set db [lindex [lindex $rec 1] 1]
  16                         foreach tagset [lrange [lindex $rec 2] 1 end] {
  17                                 if {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.1"} {
  18                                         foreach attributeType [lindex $tagset 1] {
  19                                                 if {[lindex [lindex $attributeType 0] 1] == 1} {
  20                                                         foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
  21                                                                 lappend profile($target,AttributeDetails,$db,Bib1Use) [lindex [lindex [lindex $attributeValues 0] 1] 1]
  22                                                         }
  23                                                 }
  24                                         }
  25                                 } elseif {[lindex [lindex $tagset 0] 1] == "1.2.840.10003.3.5"} {
  26 #                                       .debug-window.top.t insert end Gils\n
  27                                         foreach attributeType [lindex $tagset 1] {
  28 #                                       .debug-window.top.t insert end [lindex $tagset 1]
  29                                                 if {[lindex [lindex $attributeType 0] 1] == 1} {
  30                                                         foreach attributeValues [lrange [lindex $attributeType 2] 1 end] {
  31                                                                 lappend profile($target,AttributeDetails,$db,Gils) [lindex [lindex [lindex $attributeValues 0] 1] 1]
  32 #                                                               .debug-window.top.t insert end [lindex [lindex [lindex $attributeValues 0] 1] 1]\n
  33                                                         }
  34                                                 }
  35                                         }
  36                                 }
  37                         }
  38                         incr index
  39                 }
  40                 rename z39.attributeDetails ""
  41         } else {
  42                 .debug-window.top.t insert end "Ingen explain\n"
  43         }
  44 }
  45
  46 #Procedure change-queryInfo {target base}
  47 #The queryInfo array is set according to the attributes obtained by explain.
  48 proc change-queryInfo {target base} {
  49         global queryInfo profile bib1
  50         foreach tag $profile($target,AttributeDetails,$base,Bib1Use) {
  51                 if {$tag < 1037} {
  52                         lappend tempList [list $bib1($tag) 1=$tag]
  53                 }
  54         }
  55         set queryInfo [lreplace $queryInfo 2 2 $tempList]
  56 }
  57
  58
  59 # Procedure explain-search
  60 #  Issue search request with explain-attribute set and specific
  61 #  category.
  62 proc explain-search-request {target zz category finish response fresponse} {
  63     z39 callback [list explain-search-response $target $zz $category $finish \
  64             $response $fresponse]
  65     ir-set $zz z39
  66     $zz databaseNames IR-Explain-1
  67     $zz preferredRecordSyntax explain
  68     $zz search "@attrset exp1 @attr 1=1 @attr 2=3 @attr 3=3 @attr 4=3 $category"
  69 }
  70
  71 # Procedure explain-search-response
  72 #  Deal with search response.
  73 proc explain-search-response {target zz category finish response fresponse} {
  74     global cancelFlag
  75
  76     apduDump
  77     if {$cancelFlag} {
  78         close-target
  79         return
  80     }
  81     set status [$zz responseStatus]
  82     if {![string compare [lindex $status 0] NSD]} {
  83         $fresponse $target $zz $category $finish
  84         return
  85     }
  86     set cnt [$zz resultCount]
  87     if {$cnt <= 0} {
  88         $fresponse $target $zz $category $finish
  89         return
  90     }
  91     set rr [$zz numberOfRecordsReturned]
  92     set cnt [expr $cnt - $rr]
  93     if {$cnt <= 0} {
  94         explain-present-response $target $zz $category $finish $response $fresponse
  95         return
  96     }
  97     z39 callback [list explain-present-response $target $zz $category $finish \
  98                 $response $fresponse]
  99     incr rr
 100     $zz present $rr $cnt
 101 }
 102
 103 # Procedure explain-present-response
 104 #  Deal with explain present response.
 105 proc explain-present-response {target zz category finish response fresponse} {
 106     global cancelFlag
 107
 108     apduDump
 109     if {$cancelFlag} {
 110         close-target
 111         return
 112     }
 113     set cnt [$zz resultCount]
 114     ir-log debug "cnt=$cnt"
 115     for {set i 1} {$i <= $cnt} {incr i} {
 116                 if {[string compare [$zz type $i] DB]} {
 117                     $fresponse $target $zz $category $finish
 118                     return
 119                 }
 120                 if {[string compare [$zz recordType $i] Explain]} {
 121                     $fresponse $target $zz $category $finish
 122                     return
 123                 }
 124     }
 125     $response $target $zz $category $finish
 126 }
 127
 128
 129 # Procedure explain-check-0
 130 #  Phase 0: CategoryList
 131 proc explain-check-0 {target zz category finish} {
 132     show-status Explaining 1 0
 133     show-message CategoryList
 134     explain-search-request $target z39.categoryList CategoryList $finish \
 135                 explain-check-5 explain-check-fail
 136 }
 137
 138 # Procedure explain-check-5
 139 #  TargetInfo
 140 proc explain-check-5 {target zz category finish} {
 141     show-status Explaining 1 0
 142     show-message TargetInfo
 143
 144     explain-search-request $target z39.targetInfo TargetInfo $finish \
 145                 explain-check-10 explain-check-fail
 146 }
 147
 148 # Procedure explain-check-10
 149 #  DatabaseInfo
 150 proc explain-check-10 {target zz category finish} {
 151     show-status Explaining 1 0
 152     show-message DatabaseInfo
 153     explain-search-request $target z39.databaseInfo DatabaseInfo \
 154                 $finish explain-check-15 explain-check-fail
 155 }
 156
 157 # Procedure explain-check-15
 158 #  AttributeDetails
 159 proc explain-check-15 {target zz category finish} {
 160     show-status Explaining 1 0
 161     show-message AttributeDetails
 162     explain-search-request $target z39.attributeDetails AttributeDetails \
 163                 $finish explain-check-ok explain-check-ok
 164 }
 165
 166 # Proedure explain-check-fail
 167 #  Deal with explain check failure - call finish handler
 168 proc explain-check-fail {target zz category finish} {
 169     eval $finish [list $target]
 170 }
 171
 172 proc prettyDump {x} {
 173     foreach y $x {
 174                 prettyDumpR $y 0
 175     }
 176 }
 177
 178 proc prettyDumpR {x ind} {
 179     for {set i 0} {$i < $ind} {incr i} {
 180                 puts -nonewline " "
 181     }
 182     set i 0
 183     foreach y $x {
 184                 if {$i == 0} {
 185                     if {![string compare $y text]} {
 186                                 puts $x
 187                                 return
 188                     }
 189                     puts $y
 190                 } else {
 191                     prettyDumpR $y [expr $ind + 2]
 192                 }
 193                 incr i
 194     }
 195 }
 196
 197 # Procedure explain-check-ok
 198 proc explain-check-ok {target zz category finish} {
 199     global profile settingsChanged currentDb
 200
 201     puts ""
 202     puts ""
 203     puts ""
 204     puts ""
 205     set crec [z39.categoryList getExplain 1 categoryList]
 206     puts "--- categoryList"
 207     puts $crec
 208
 209     set rec [z39.targetInfo getExplain 1]
 210     set trec [z39.targetInfo getExplain 1 targetInfo]
 211     puts "--- targetInfo"
 212     puts $rec
 213
 214     set no 1
 215     while {1} {
 216         if {
 217                 [catch {set rec [z39.databaseInfo getExplain $no databaseInfo]}]
 218         } break
 219         puts "--- databaseInfo $no"
 220                 puts $rec
 221         lappend dbRecs $rec
 222         set db [lindex [lindex $rec 1] 1]
 223                 if {![string length $db]} break
 224         lappend dbList $db
 225         incr no
 226     }
 227     if {[info exists dbList]} {
 228         set profile($target,databases) $dbList
 229     }
 230     cascade-target-list
 231
 232     set no 1
 233     while {1} {
 234         if {
 235                 [catch {set rec [z39.attributeDetails getExplain $no attributeDetails]}]
 236                 } break
 237         puts "--- attributeDetails $no"
 238                 puts $rec
 239         incr no
 240     }
 241     set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
 242     if {[string length $data]} {
 243         set profile($target,descripton) $data
 244     }
 245
 246     set profile($target,namedResultSets) [lindex [lindex $trec 4] 1]
 247     set profile($target,timeLastExplain) [clock seconds]
 248     set profile($target,targetInfoName) [lindex [lindex $trec 1] 1]
 249     set profile($target,recentNews) [lindex [lindex $trec 2] 1]
 250     set profile($target,maxResultSets) [lindex [lindex $trec 6] 1]
 251     set profile($target,maxResultSize) [lindex [lindex $trec 7] 1]
 252     set profile($target,maxTerms) [lindex [lindex $trec 8] 1]
 253     set profile($target,multipleDatabases) [lindex [lindex $trec 5] 1]
 254     set profile($target,welcomeMessage) \
 255                 [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]
 256
 257     set settingsChanged 1
 258     get-attributeDetails $target $currentDb
 259
 260     eval $finish [list $target]
 261 }
 262
 263 # Procedure explain-refresh
 264 proc explain-refresh {target finish} {
 265     explain-check-0 $target {} {} $finish
 266 }
 267
 268 # Procedure explain-check
 269 #   Checks target for explain database.
 270 #   Evals "$finish $target" on finish.
 271 proc explain-check {target finish base} {
 272     global profile
 273
 274     set refresh 0
 275     set time [clock seconds]
 276     set etime $profile($target,timeLastExplain)
 277     if {[string length $etime]} {
 278         # Check last explain. If 1 day since last explain do explain again.
 279         # 1 day = 86400
 280         if {$time > [expr 0 + $etime]} {
 281                 set refresh 1
 282         }
 283     } else {
 284         # Check last init. If never init or 1 week after do explain anyway.
 285         # 1 week = 604800
 286         set etime $profile($target,timeLastInit)
 287         if {![string length $etime]} {
 288                 set refresh 1
 289         } elseif {$time > [expr 604800 + $etime]} {
 290                 set refresh 1
 291         }
 292     }
 293     if {$refresh} {
 294                 explain-refresh $target $finish
 295     } else {
 296                 eval $finish [list $target]
 297     }
 298 }