perlmqmsgque 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 perlmqmsgque.

To perform the test multiple classes are created and connected using the perlmqmsgque 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 perlmqmsgque protocoll and build together a tree-like structure.

The GOAL for this setup is:

CODE server

#+
#:   @file         example/perl/MyRouter.pl
#:   @brief        MyRouter.pl - 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>
#:

use strict;
use warnings;
use PerlMqMsgque;

package Basic;
use parent qw(PerlMqMsgque::MqContextC);

use constant {
  ID1 => 11,
  ID2 => 12,
};

sub CreateWorker {
  my ($ctx, $master_id, $factory) = (@_);
  $ctx->SlaveWorkerVA( $master_id, $factory,  '--prefix', "cl$factory-$master_id", '@',
                                              '--prefix', "sv$factory-$master_id"
  );
}

sub HLWO {
  my $ctx = shift;
  $ctx->Send("R", "C", $ctx->ConfigGetName());
}

sub FOID {
  my $ctx = shift;
  $ctx->Send("R", "C", $ctx->ClassOriginalIdentGet() . "-" . $ctx->LinkGetCtxId());
}

sub PATH {
  my $ctx = shift;
  $ctx->Send("R", "C", $ctx->RouteGetPath());
}

sub TREE {
  my $ctx = shift;
  $ctx->Send("R", "L", $ctx->RouteGetTree());
}

sub HLWS {
  my $ctx = shift;
  $ctx->SlaveGetMaster()->Setup();
  $ctx->SendRETURN();
}

sub Setup {
  my $ctx = shift;
  $ctx->ServiceCreate("HLWO", \&HLWO);
  $ctx->ServiceCreate("FOID", \&FOID);
  $ctx->ServiceCreate("PATH", \&PATH);
  $ctx->ServiceCreate("TREE", \&TREE);
  $ctx->ServiceCreate("HLWS", \&HLWS);
}

sub new {
  my $class = shift;
  return $class->SUPER::new(@_);
}

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

package WO1;
use parent -norequire, qw(Basic);

sub ServerSetup {
  my $ctx = shift;
  if ($ctx->LinkIsParent()) {
    $ctx->CreateWorker(Basic::ID1, "WO2");
    $ctx->CreateWorker(Basic::ID2, "WO2");
  }
  $ctx->Setup();
}

sub new {
  my $class = shift;
  my $ctx = $class->SUPER::new(@_);
  $ctx->ConfigSetServerSetup(\&WO1::ServerSetup);
  return $ctx;
}

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

package WO2;
use parent -norequire, qw(Basic);

sub ServerSetup {
  my $ctx = shift;
  if ($ctx->LinkIsParent()) {
    $ctx->CreateWorker(Basic::ID1, "WO3");
    $ctx->CreateWorker(Basic::ID2, "WO3");
  }
  $ctx->Setup();
}

sub new {
  my $class = shift;
  my $ctx = $class->SUPER::new(@_);
  $ctx->ConfigSetServerSetup(\&WO2::ServerSetup);
  return $ctx;
}

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

package WO3;
use parent -norequire, qw(Basic);

sub FINL {
  my $ctx = shift;
  $ctx->Send("R", "C", "FINL-" . $ctx->ConfigGetName());
}

sub ServerSetup {
  my $ctx = shift;
  $ctx->Setup();
  $ctx->ServiceCreate("FINL", \&FINL);
}

sub new {
  my $class = shift;
  my $ctx = $class->SUPER::new(@_);
  $ctx->ConfigSetServerSetup(\&WO3::ServerSetup);
  return $ctx;
}

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

package main;

# toplevel error handler
eval {

  # create buffer-list of the application arguments
  my $largv = MkBufferListC->CreateVA(@ARGV);

  # add factories
  MqFactoryC->Add("WO1")->Default();
  MqFactoryC->Add("WO2");
  MqFactoryC->Add("WO3");

  # select factory using the !first! application argument
  # and create a new server
  my $srv = MqFactoryC->GetCalledL($largv)->New;

  # server error handler
  eval {

    # configure and start the server
    $srv->LinkCreate($largv);

    # start event-loop and wait forever
    $srv->ProcessEvent(MqWaitOnEventE->{FOREVER});
  } or do {

    # set the libmqmsgque error from the perl error
    $srv->ErrorCatch($@);
  };

  # exit aplication and cleanup the environment
  $srv->Exit();

} or do {
  MkErrorC->DEFAULT()->Catch($@)->Println();
};

1;