perlmqmsgque 9.0
Loading...
Searching...
No Matches
Example: perfserver

Documentation of the perfserver tool used for example.test.

INTRODUCTION

The perfserver tool is used server-part of the performance-test

To perform the test the perfclient send various service request to the perfserver. The perfclient is written in C and finally create a report.

All context created, are connected using the perlmqmsgque protocoll and build together a flat-like structure.

The GOAL for this setup is:

CODE server

#+
#:   @file         example/perl/perfserver.pl
#:   @brief        perfserver.pl - 03 May 2023 - aotto1968
#:   @copyright    (C) NHI - #1 - Project - Group
#:                 This software has NO permissions to copy,
#:                 please contact AUTHOR for additional information
#:   @version      1c3a8f89f6bbd5c146252125f8a426400f6e1300
#:   @date         Wed May 3 12:28:13 2023 +0200
#:   @author       aotto1968 <aotto1968@t-online.de>
#:

# [server_example]
use strict;
use warnings;
use PerlMqMsgque;

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

  # factory constructor
  sub new {
    my $class = shift;
    my $ctx = $class->SUPER::new(@_);
    $ctx->ConfigSetServerSetup(\&ServerSetup);
    return $ctx;
  }
  
  sub ECOU {
    my $ctx = shift;
    $ctx->SendSTART;
    $ctx->SendU($ctx->ReadU);
    $ctx->SendRETURN;
  }

  sub ECOI {
    my $ctx = shift;
    $ctx->SendSTART();
    $ctx->SendI($ctx->ReadI());
    $ctx->SendRETURN();
  }

  sub ECUL {
    my $ctx = shift;
    $ctx->SendSTART();
    $ctx->SendY ($ctx->ReadY());
    $ctx->SendS ($ctx->ReadS());
    $ctx->SendI ($ctx->ReadI());
    $ctx->SendD ($ctx->ReadD());
    $ctx->ProxyItem ($ctx);
    $ctx->SendRETURN();
  }

  sub RDUL {
    my $ctx = shift;
    $ctx->ReadY ();
    $ctx->ReadS ();
    $ctx->ReadI ();
    $ctx->ReadD ();
    $ctx->ReadU ();
  }

  sub RDUC {
    my $ctx = shift;
    $ctx->ReadC ();
    $ctx->ReadC ();
    $ctx->ReadC ();
    $ctx->ReadC ();
    $ctx->ReadC ();
  }

  sub STDB {
    my $ctx = shift;
    $ctx->SendSTART();
    $ctx->StorageOpen($ctx->ReadC());
    $ctx->SendRETURN();
  }

  sub STDC {
    my $ctx = shift;
    $ctx->SendSTART();
    $ctx->StorageClose();
    $ctx->SendRETURN();
  }

  # [BufferStream-Create-TLS]
  sub BUST {
    my $ctx = shift;
    my $bus = ::MkBufferStreamC->CreateTLS(0);
    while ($ctx->ReadItemExists()) {
      $bus->WriteU($ctx->ReadU());
    }
    $bus->PosToStart();
    $ctx->SendSTART();
    while ($bus->ReadItemExists()) {
      $ctx->SendU($bus->ReadU());
    }
    $ctx->SendRETURN();
  }
  # [BufferStream-Create-TLS]

  # [BufferList-Create-TLS]
  sub BFLT {
    my $ctx = shift;
    my $bfl = ::MkBufferListC->CreateTLS(0);
    while ($ctx->ReadItemExists()) {
      $bfl->AppendU($ctx->ReadU());
    }
    $ctx->SendSTART();
    foreach my $i (0..$bfl->Size()-1) {
      $ctx->SendU($bfl->IndexGet($i));
    }
    $ctx->SendRETURN();
  }
  # [BufferList-Create-TLS]

  sub BINT {
    my $ctx = shift;
    $ctx->ReadB();
  }

  sub STRT {
    my $ctx = shift;
    $ctx->ReadC();
  }

  # define a service as link between the token "HLWO" and the callback "\&HLWO"
  sub ServerSetup {
    my $ctx = shift;
    $ctx->ServiceCreate("ECOU",\&ECOU);
    $ctx->ServiceCreate("ECOI",\&ECOI);
    $ctx->ServiceCreate("ECUL",\&ECUL);
    $ctx->ServiceCreate("RDUL",\&RDUL);
    $ctx->ServiceCreate("RDUC",\&RDUC);
    $ctx->ServiceCreate("STDB",\&STDB);
    $ctx->ServiceCreate("STDC",\&STDC);
    $ctx->ServiceCreate("BUST",\&BUST);
    $ctx->ServiceCreate("BFLT",\&BFLT);
    $ctx->ServiceCreate("BINT",\&BINT);
    $ctx->ServiceCreate("STRT",\&STRT);
  }

package main;

  # setup commandline arguments for later use
  my $largv = MkBufferListC->CreateVA(@ARGV);

  # [factory-item]
  # create "perfserver" factory... and make it to the default.
  MqFactoryC->Add("perfserver")->Default();
  # [factory-item]

  # inspect commandline-argument for the "factory" to choose... and create a new instance
  my $srv = MqFactoryC->GetCalledL($largv)->New();

  eval {
    $srv->LinkCreate($largv);
    $srv->ProcessEvent(MqWaitOnEventE->{FOREVER});
  } or do {
    $srv->ErrorCatch($@);
  };
  $srv->Exit();
1;
# [server_example]