Documentation of the MyRouter tool used for route2.test
.
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.
|-> 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:
#!/usr/bin/env tclsh #+ #: @file NHI1/example/tcl/MyRouter.tcl #: @brief MyRouter.tcl - 26 Jun 2024 - aotto1968 #: @copyright (C) NHI - #1 - Project - Group #: This software has NO permissions to copy, #: please contact AUTHOR for additional information #: @version 08a242faddae5101924d8fe811888e78892a82d9 #: @date Wed Jun 26 14:26:21 2024 +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 SendSTR "[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]