explain.tcl

   1
   2 proc explain-search {target zz category finish response fresponse} {
   3     z39 callback [list explain-search-r $target $zz $category $finish \
   4             $response $fresponse]
   5     ir-set $zz z39
   6     $zz databaseNames IR-Explain-1
   7     $zz preferredRecordSyntax explain
   8     $zz search "@attrset exp1 @attr 1=1 $category"
   9 }
  10
  11 proc explain-search-r {target zz category finish response fresponse} {
  12     global cancelFlag
  13
  14     apduDump
  15     if {$cancelFlag} {
  16         close-target
  17         return
  18     }
  19     set status [$zz responseStatus]
  20     if {![string compare [lindex $status 0] NSD]} {
  21         $fresponse $target $zz $category $finish
  22         return
  23     }
  24     set cnt [$zz resultCount]
  25     if {$cnt <= 0} {
  26         $fresponse $target $zz $category $finish
  27         return
  28     }
  29     set rr [$zz numberOfRecordsReturned]
  30     set cnt [expr $cnt - $rr]
  31     if {$cnt <= 0} {
  32         $response $target $zz $category $finish
  33         return
  34     }
  35     z39 callback [list $response $target $zz $category $finish]
  36     incr rr
  37     $zz present $rr $cnt
  38 }
  39
  40 proc explain-check {target finish} {
  41     global profile
  42
  43     set time [clock seconds]
  44     set etime [lindex $profile($target) 19]
  45     if {[string length $etime]} {
  46         # Check last explain. If 1 day since last explain do explain egain.
  47         # 1 day = 86400
  48         if {$time > [expr 180 + $etime]} {
  49             explain-start $target $finish
  50             return
  51         }
  52     } else {
  53         # Check last init. If never init or 1 week after do explain anyway.
  54         # 1 week = 604800
  55         set etime [lindex $profile($target) 18]
  56         if {![string length $etime]} {
  57             explain-start $target $finish
  58             return
  59         } elseif {$time > [expr 604800 + $etime]} {
  60             explain-start $target $finish
  61             return
  62         }
  63     }
  64     eval $finish [list $target]
  65 }
  66
  67 proc explain-start {target finish} {
  68     show-status Explaining 1 0
  69     show-message TargetInfo
  70     explain-search $target z39.targetInfo TargetInfo $finish \
  71             explain-check-1 explain-check-1f
  72 }
  73
  74 proc explain-check-1f {target zz category finish} {
  75     eval $finish [list $target]
  76 }
  77
  78 proc explain-check-1 {target zz category finish} {
  79     show-status Explaining 1 0
  80     show-message DatabaseInfo
  81     explain-search $target z39.databaseInfo DatabaseInfo $finish \
  82             explain-check-2 explain-check-1f
  83 }
  84
  85 proc explain-check-2 {target zz category finish} {
  86     global profile settingsChanged
  87
  88     set trec [z39.targetInfo getExplain 1 targetInfo]
  89     puts "--- targetInfo"
  90     puts $trec
  91     set no 1
  92     while {1} {
  93         if {[catch {set rec \
  94                 [z39.databaseInfo getExplain $no databaseInfo]}]} break
  95         puts "--- databaseInfo $no"
  96         puts $rec
  97
  98         lappend dbRecs $rec
  99         set db [lindex [lindex $rec 1] 1]
 100         if {![string length $db]} break
 101         lappend dbList $db
 102         incr no
 103     }
 104     if {[info exists dbList]} {
 105         set profile($target) [lreplace $profile($target) 7 7 $dbList]
 106         set profile($target) [lreplace $profile($target) 25 25 {}]
 107     }
 108     cascade-target-list
 109
 110     set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1]
 111     if {[string length $data]} {
 112         set profile($target) [lreplace $profile($target) 0 0 $data]
 113     }
 114
 115     set l [llength $profile($target)]
 116     while {$l < 29} {
 117         lappend profile($target) {}
 118         incr l
 119     }
 120
 121     set profile($target) [lreplace $profile($target) 8 8 \
 122             [lindex [lindex $trec 4] 1]]
 123     set profile($target) [lreplace $profile($target) 19 19 \
 124             [clock seconds]]
 125     set profile($target) [lreplace $profile($target) 20 20 \
 126             [lindex [lindex $trec 1] 1]]
 127     set profile($target) [lreplace $profile($target) 21 21 \
 128             [lindex [lindex $trec 2] 1]]
 129     set profile($target) [lreplace $profile($target) 22 22 \
 130             [lindex [lindex $trec 6] 1]]
 131     set profile($target) [lreplace $profile($target) 23 23 \
 132             [lindex [lindex $trec 7] 1]]
 133     set profile($target) [lreplace $profile($target) 24 24 \
 134             [lindex [lindex $trec 8] 1]]
 135     set profile($target) [lreplace $profile($target) 26 26 \
 136             [lindex [lindex $trec 5] 1]]
 137     set profile($target) [lreplace $profile($target) 27 27 \
 138             [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]]
 139
 140     set settingsChanged 1
 141
 142     eval $finish [list $target]
 143 }