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