tclmqmsgque 9.0
Loading...
Searching...
No Matches
Example: MyRouter

Documentation of the MyRouter tool used for route2.test.

INTRODUCTION

The MyRouter tool is used to test the routing-feature of tclmqmsgque.

To perform the test multiple classes are created and connected using the tclmqmsgque protocol.
The following class-hierarchie is used:

       Base
   |----|----|
  WO1  WO2  WO3       

The routing-test is perfomed by connecting multiple context.

  • The client connect to the WO1-context.
  • On WO1-ServerSetup the WO1-context create two WO2-context using the CreateWorker methode from Base.
  • On WO2-ServerSetup the W02-context create two WO3-context using the CreateWorker methode from Base.
                           |-> WO3#1
                |-> WO2#1 -|-> WO3#2
 client -> WO1 -|
                |-> W02#2 -|-> WO3#1
                           |-> WO3#2

All context created, 1x client and 7x server, are connected using the tclmqmsgque protocoll and build together a tree-like structure.

The GOAL for this setup is:

CODE server

#!/usr/bin/env tclsh
#+
#:   @file         example/tcl/MyRouter.tcl
#:   @brief        MyRouter.tcl - 02 May 2023 - aotto1968
#:   @copyright    (C) NHI - #1 - Project - Group
#:                 This software has NO permissions to copy,
#:                 please contact AUTHOR for additional information
#:   @version      d2cd8f6ec2179f5e5583ae98faed11359996631d
#:   @date         Tue May 2 21:28:46 2023 +0200
#:   @author       aotto1968 <aotto1968@t-online.de>
#:

# [rooter_server_example]
package require tclmsgque::MqMsgque
namespace import tclmsgque::MqMsgque::*
namespace import tclmsgque::MkKernel::*

::oo::class create Basic {
  superclass MqContextC

  constructor {{tmpl ""}} {
    next $tmpl
    my variable id1 id2
    set id1 11
    set id2 12
  }

  method CreateWorker {master_id factory} {
    my SlaveWorker $master_id $factory \
      "--prefix" "cl$factory-$master_id" "@" "--prefix" "sv$factory-$master_id"

    my SlaveGet $master_id
  }

  method HLWO {} {
    my Send "R" "C" [my ConfigGetName]
  }
  
  method FOID {} {
    my SendSTART
    my SendC "[my ClassOriginalIdentGet]-[my LinkGetCtxId]"
    my SendRETURN
  }
  
  method PATH {} {
    my Send "R" "C" [my RouteGetPath]
  }

  method TREE {} {
    my Send "R" "L" [my RouteGetTree]
  }

  method HLWS {} {
    [my SlaveGetMaster] setup
    my Send "R"
  }
  
  method setup {} {
    my ServiceCreate "HLWO"  HLWO
    my ServiceCreate "FOID"  FOID
    my ServiceCreate "PATH"  PATH
    my ServiceCreate "TREE"  TREE
    my ServiceCreate "HLWS"  HLWS
  }
}

# ************************************************************

::oo::class create WO1 {
  superclass Basic
  constructor {{tmpl ""}} {
    next $tmpl
    my ConfigSetServerSetup serverSetup
  }
  method serverSetup {} {
    if {[my LinkIsParent]} {
      my variable id1 id2
      my CreateWorker $id1  "WO2"
      my CreateWorker $id2  "WO2"
    }
    my setup
  }
}

# ************************************************************

::oo::class create WO2 {
  superclass Basic
  constructor {{tmpl ""}} {
    next $tmpl
    my ConfigSetServerSetup serverSetup
  }
  method serverSetup {} {
    if {[my LinkIsParent]} {
      my variable id1 id2
      my CreateWorker $id1  "WO3"
      my CreateWorker $id2  "WO3"
    }
    my setup
  }
}

# ************************************************************

::oo::class create WO3 {
  superclass Basic
  constructor {{tmpl ""}} {
    next $tmpl
    my ConfigSetServerSetup serverSetup
  }
  method FINL {} {
    my Send "R" "C" FINL-[my ConfigGetName]
  }
  method serverSetup {} {
    my ServiceCreate "FINL"  FINL
    my setup
  }
}

tclmsgque::MqMsgque Main {

  # setup commandline arguments for later use
  set args  [MkBufferListC CreateLA {*}$argv]

  # create factory... and default.
  [MqFactoryC Add WO1] Default
  MqFactoryC Add WO2
  MqFactoryC Add WO3

  # inspect commandline-argument for the "factory" to choose... and create a object
  set srv   [[MqFactoryC GetCalledL $args] New]

  try {
    $srv LinkCreate $args
    $srv ProcessEvent MQ_WAIT_FOREVER
  } on error {} {
    $srv ErrorCatch
  } finally {
    $args destroy
    $srv Exit
  }
}
# [rooter_server_example]