msearch.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: msearch.tcl,v 1.2 2001-12-03 18:52:06 adam Exp $
   3 # Simple multi-target search
   4
   5 if {[catch {ir-log-init all irtcl shell.log}]} {
   6     set e [info sharedlibextension]
   7     puts "Loading irtcl$e ..."
   8     load ./irtcl$e irtcl
   9     ir-log-init all irtcl shell.log
  10 }
  11
  12 proc msearch {targets query pending} {
  13         global $pending
  14
  15         set n 0
  16         foreach t $targets {
  17                 ir z.$n
  18                 z.$n databaseNames [lindex $t 1]
  19                 ir-set z.$n.1 z.$n
  20                 z.$n failback [list fail-response $targets $n $query $pending]
  21                 z.$n callback [list connect-response $targets $n $query $pending]
  22                 incr n
  23         }
  24         set n 0
  25         foreach t $targets {
  26                 if {[catch {z.$n connect [lindex $t 0]}]} {
  27                         fail-response $targets $n $query $pending
  28                 }
  29                 incr n
  30         }
  31         set $pending $n
  32 }
  33
  34 proc fail-response {targets n query pending} {
  35         global $pending
  36
  37         puts "[lindex $targets $n]: failed"
  38         incr $pending -1
  39 }
  40
  41 proc connect-response {targets n query pending} {
  42         global $pending
  43
  44         puts "[lindex $targets $n]: connect response"
  45         z.$n callback [list init-response $targets $n $query $pending]
  46         if {[catch {z.$n init}]} {
  47                 incr $pending -1
  48         }
  49 }
  50
  51 proc init-response {targets n query pending} {
  52         global $pending
  53
  54         puts "[lindex $targets $n]: init response"
  55         if {![z.$n initResult]} {
  56                 puts "connection rejected: [z.$n userInformationField]"
  57                 incr $pending -1
  58         } else {
  59                 z.$n callback [list search-response $targets $n $query $pending]
  60                 if {[catch {z.$n.1 search $query}]} {
  61                         puts "[lindex $targets $n]: bad query $query"
  62                         incr $pending -1
  63                 }
  64         }
  65 }
  66
  67 proc search-response {targets n query pending} {
  68         global $pending
  69
  70         puts "[lindex $targets $n]: search response"
  71         set sstatus [z.$n.1 searchStatus]
  72         if {$sstatus} {
  73                 set h [z.$n.1 resultCount]
  74                 puts "[lindex $targets $n]: search ok"
  75                 puts "[lindex $targets $n]: $h hits"
  76         } else {
  77                 puts "[lindex $targets $n]: search failed"
  78         }
  79         incr $pending -1
  80 }
  81
  82 msearch {{bagel.indexdata.dk gils} {localhost:9999 Default} {z3950.bell-labs.com books}} utah ok
  83
  84 # This looping is optional if you're using Tk (X11)
  85 while {$ok} {
  86         vwait ok
  87 }
  88 puts "Finished searching"