mem.tcl

   1 set count 0
   2
   3 proc fail-response {} {
   4     puts "Fail-response"
   5 }
   6
   7 proc present-response-a {} {
   8     puts "present-response-a"
   9     z disconnect
  10     rename z.1 {}
  11     rename z {}
  12     start
  13 }
  14
  15 proc present-response-b {} {
  16     puts "present-response-a"
  17     z disconnect
  18     rename z.1 {}
  19     z callback {connect-response}
  20     z connect localhost:9999
  21 }
  22
  23 proc search-response {} {
  24     puts "search-response"
  25     set hits [z.1 resultCount]
  26     if {$hits > 0} {
  27         z callback {present-response-a}
  28         z.1 present 1 $hits
  29         return
  30     }
  31     z disconnect
  32     rename z.1 {}
  33     rename z {}
  34     start
  35 }
  36
  37 proc init-response {} {
  38     puts "init-reponse"
  39     ir-set z.1 z
  40     z callback {search-response}
  41     z.1 search adam
  42 }
  43
  44 proc connect-response {} {
  45     global count
  46
  47     incr count
  48     puts $count
  49     puts "connect-response"
  50     z callback {init-response}
  51     z databaseNames A
  52     z init
  53 }
  54
  55 proc start {} {
  56     ir z
  57     z comstack tcpip
  58     z failback {fail-response}
  59     z callback {connect-response}
  60     z connect localhost:9999
  61 }
  62
  63 start
  64