tclmqmsgque 9.0
Loading...
Searching...
No Matches
Example: Identification-Test

Documentation of the Test-Client-Server tool used for example.test.

INTRODUCTION

The Naming-Test-Tool tool is used to test the name-resolution-feature of tclmqmsgque.

To perform the test 2 tools are used, the testclient and the testserver.

testclient

This tool creates multiple parent and child client-context, all using a --postfix argument to identify unique.

testserver This tool listen on the service GTCX and return the unique identification pattern of the server-context in duty.

All context created, 8x client and 8x server, are connected using the tclmqmsgque protocoll and build together a flat structure.

The GOAL for this setup is:

CODE client

#!/usr/bin/env tclsh
#+
#:   @file         example/tcl/testclient.tcl
#:   @brief        testclient.tcl - 12 Jun 2022 - aotto1968
#:   @copyright    (C) NHI - #1 - Project - Group
#:                 This software has NO permissions to copy,
#:                 please contact AUTHOR for additional information
#:   @version      fd4af83a6d78da00e503acf12b12172f948d5c39
#:   @date         Sun Jun 12 12:13:27 2022 +0200
#:   @author       aotto1968 <aotto1968@t-online.de>
#:

package require tclmsgque::MqMsgque

set server  [file join [file dirname [info script]] testserver.tcl]

proc Get {ctx} {
  $ctx SendSTART
  $ctx SendEND_AND_WAIT "GTCX"
  append RET [$ctx ConfigGetName]
  append RET "+"
  append RET [$ctx ReadC]
  append RET [$ctx ReadC]
  append RET [$ctx ReadC]
  append RET [$ctx ReadC]
  append RET [$ctx ReadC]
  append RET [$ctx ReadC]
  return $RET
}

# create object
set LIST [list c0 c00 c01 c000 c1 c10 c100 c101]
foreach F $LIST {
  set FH($F) [tclmsgque::MqMsgque::MqContextC Create]
}

## create link
$FH(c0)	  LinkCreate		    "--postfix" "0"   "--prefix" "c" "--debug" $env(TS_DEBUG) "@" \
                                                              $env(TCLSH) $server "--prefix" "s"
$FH(c00)  LinkCreateChild $FH(c0)   "--postfix" "00"  
$FH(c01)  LinkCreateChild $FH(c0)   "--postfix" "01"  
$FH(c000) LinkCreateChild $FH(c00)  "--postfix" "000" 
$FH(c1)	  LinkCreate     	    "--postfix" "1"   "--prefix" "c"  {*}$argv
$FH(c10)  LinkCreateChild $FH(c1)   "--postfix" "10"  
$FH(c100) LinkCreateChild $FH(c10)  "--postfix" "100" 
$FH(c101) LinkCreateChild $FH(c10)  "--postfix" "101" 

## do the tests
foreach F $LIST {
  puts [Get $FH($F)]
}

## cleanup
foreach n [lreverse $LIST] {
  $FH($n) Delete
}

CODE server

#!/usr/bin/env tclsh
#+
#:   @file         example/tcl/testserver.tcl
#:   @brief        testserver.tcl - 12 Jun 2022 - aotto1968
#:   @copyright    (C) NHI - #1 - Project - Group
#:                 This software has NO permissions to copy,
#:                 please contact AUTHOR for additional information
#:   @version      fd4af83a6d78da00e503acf12b12172f948d5c39
#:   @date         Sun Jun 12 12:13:27 2022 +0200
#:   @author       aotto1968 <aotto1968@t-online.de>
#:

package require tclmsgque::MqMsgque

proc GTCX {ctx} {
  $ctx SendSTART
  $ctx SendI [$ctx LinkGetCtxId]
  $ctx SendC "+"
  if {[$ctx LinkIsParent]} {
    $ctx SendI -1
  } else {
    $ctx SendI [[$ctx LinkGetParent] LinkGetCtxId]
  }
  $ctx SendC "+"
  $ctx SendC [$ctx ConfigGetName]
  $ctx SendC ":"
  $ctx SendRETURN
}
proc ServerSetup {ctx} {
  $ctx ServiceCreate "GTCX" GTCX
}
tclmsgque::MqMsgque Main {
  tclmsgque::MqMsgque::MqContextC create srv
  srv ConfigSetServerSetup ServerSetup
  try {
    srv LinkCreate {*}$argv
    srv ProcessEvent MQ_WAIT_FOREVER
  } on error {} {
    srv ErrorCatch
  } finally {
    srv Exit
  }
}