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

Documentation of the Filter6 tool used for trans2.test.

INTRODUCTION

The Filer6 tool is used to test the filter-feature of perlmqmsgque.

To run the filter test, a first client, one or more filters and a final server are created. All are connected to the perlmqmsgque protocol.

The trans2.test carries out common filter tests and special stress tests. A stress test is performed by exiting one or more filters or servers and observing the response and behavior when reconnecting.

The GOAL for this test is:

CODE filter

#+
#:   @file         example/perl/Filter6.pl
#:   @brief        Filter6.pl - 06 Jan 2023 - aotto1968
#:   @copyright    (C) NHI - #1 - Project - Group
#:                 This software has NO permissions to copy,
#:                 please contact AUTHOR for additional information
#:   @version      3229edb4ba23c4273fd3e1cd50d2f1ada9252a7b
#:   @date         Fri Jan 6 22:13:29 2023 +0100
#:   @author       aotto1968 <aotto1968@t-online.de>
#:

use strict;
use warnings;
use PerlMqMsgque;
use FileHandle;

#$| = 1;

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

  sub ErrorWrite {
    my $ctx = shift;
    my $err = $ctx->ErrorDEFAULT();
    $ctx->cls->{FH}->WriteC("ERROR: " . $err->GetText);
    $err->Reset();
  }

  sub Event {
    my $ctx = shift;
    if ($ctx->StorageCount() == 0) {
      $ctx->ErrorDEFAULT()->SetCONTINUE;
    } else {
      my $Id = 0;
      eval {
	my $ftr = $ctx->SlaveGetFilter();
        $Id = $ctx->StorageImport();
        eval {
          $ctx->ProxyForward($ftr);
        } or do {
          if (::MkExceptionC->Check($@)) {
            if ($ctx->StorageErrCnt($Id) <= 3) {
              $ctx->StorageDecrRef($Id);
              return 0;
            } else {
              die $@
            }
          } else {
            die $@;
          }
        };
      } or do {
        if (!$@) {
          return 1;
        } else {
          my $err = $@;
          $ctx->ErrorCatch($err);
          $ctx->ErrorWrite();
        }
      };
      $Id = $ctx->StorageDelete($Id);
    }
  }

  sub FilterIn {
    my $ctx = shift;
    $ctx->StorageExport();
    $ctx->SendRETURN();
  }

  sub LOGF {
    my $ctx = shift;
    my $ftr = $ctx->SlaveGetFilter();
    if ($ftr->ConfigGetName() =~ /^(?:Filter6-1|Filter6|fs1.*)$/) {
      $ctx->cls->{FH} =  ::MkLogFileC->Open($ctx,$ctx->ReadC);
    } else {
      $ctx->ProxyForward($ftr);
    }
    $ctx->SendRETURN();
  }

  sub WRIT {
    my $ftr = shift;
    my $master = $ftr->SlaveGetMaster();
    if ($master->ConfigGetName() =~ /^(?:Filter6-1|Filter6|fs1.*)$/) {
      $master->cls->{FH}->WriteC($ftr->ReadC);
    } else {
      $ftr->ProxyForward($master);
    }
    $ftr->SendRETURN();
  }

  sub EXIT {
    my $ctx = shift;
    $ctx->Exit();
  }

  sub SOEX {
    my $ctx = shift;
    $ctx->ErrorSetEXIT;
  }

  sub ServerCleanup {
    my $ctx = shift;
    my $FH = $ctx->cls->{FH};
    if (defined($FH)) {
      $FH->Close();
      $ctx->cls->{FH} =  undef;
    }
  }

  # [filter_service_example]
  sub ServerSetup {
    my $ctx = shift;
    my $ftr = $ctx->SlaveGetFilter();

    $ctx->ServiceCreate   ("LOGF", \&LOGF);
    $ctx->ServiceCreate   ("EXIT", \&EXIT);
    $ctx->ServiceCreate   ("SOEX", \&SOEX);
    $ctx->ServiceCreate   ("+ALL", \&FilterIn);
    $ctx->ServiceStorage  ("PRNT");
    $ctx->ServiceStorage  ("PRN2");
    $ftr->ServiceCreate   ("WRIT", \&WRIT);
    $ctx->ServiceCreate   ("WRIT", \&WRIT);
    $ftr->ServiceProxy    ("WRT2", ::MqSlaveE->{MASTER});

    $ctx->cls->{FH} =  undef;
  }
  # [filter_service_example]

  sub new {
    my $class = shift;
    my $ctx = $class->SUPER::new(@_);
    $ctx->ConfigSetIgnoreExit(1);
    $ctx->ConfigSetServerSetup(\&ServerSetup);
    $ctx->ConfigSetServerCleanup(\&ServerCleanup);
    $ctx->ConfigSetEvent(\&Event);
    return $ctx;
  }


# [error_example]
package main;

  my $srv = MqFactoryC->Add("Filter6")->New();
  eval {
    $srv->LinkCreateVA(@ARGV);
    $srv->ProcessEvent(MqWaitOnEventE->{FOREVER});
  } or do {
    $srv->ErrorCatch($@);
  };
  $srv->Exit();

1;
# [error_example]