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

To run the filter test, a first client, one or more filters and a final server are created. All are connected to the tclmqmsgque 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

#!/usr/bin/env tclsh
#+
#:   @file         NHI1/example/tcl/Filter6.tcl
#:   @brief        Filter6.tcl - 23 Jul 2024 - aotto1968
#:   @copyright    (C) NHI - #1 - Project - Group
#:                 This software has NO permissions to copy,
#:                 please contact AUTHOR for additional information
#:   @version      e6ce5cfbf6c7dfb4f0b3eb45bb50508830143224
#:   @date         Tue Jul 23 22:39:27 2024 +0200
#:   @author       aotto1968 <aotto1968@t-online.de>
#:

package require tclmsgque::MqMsgque
namespace import tclmsgque::MqMsgque::*
namespace import tclmsgque::MkKernel::*

::oo::class create Filter6 {
  superclass MqContextC
  export variable

  constructor {{tmpl ""}} {
    next $tmpl

    my ConfigSetIgnoreExit    yes
    my ConfigSetServerSetup   FilterSetup
    my ConfigSetServerCleanup FilterCleanup
    my ConfigSetEvent         FilterEvent
  }

  ## [filter_service_example]
  method FilterSetup {} {
    set ftr [my SlaveGetFilter]
    my variable FH
    set FH ""
    my ServiceCreate    "LOGF" LOGF
    my ServiceCreate    "EXIT" EXIT
    my ServiceCreate    "SOEX" SOEX
    my ServiceCreate    "ERR1" ERR1
    my ServiceStorage   "PRNT"
    my ServiceStorage   "PRN2"
    my ServiceCreate    "+ALL" FilterIn
    $ftr ServiceCreate  "WRIT" WRIT
    my ServiceCreate    "WRIT" WRIT
    $ftr ServiceProxy   "WRT2" MASTER
  }
  ## [filter_service_example]

  method FilterCleanup {} {
    my variable FH
    if {$FH ne ""} {close $FH}
    unset FH
  }

  self method errorWrite {ctx} {
    $ctx variable FH
    set err [$ctx ErrorFORMAT]
    puts $FH "ERROR: [$err GetText]"
    flush $FH
    $err Reset
  }

  method LOGF {} {
    set ftr [my SlaveGetFilter]
    if {[regexp {^(?:Filter6-1|Filter6|fs1.*)$} [$ftr ConfigGetName]]} {
      my variable FH
      set FH [open [my ReadSTR] a]
    } else {
      my ProxyForward $ftr
    }
    my SendRETURN
  }

  method WRIT {} {
    set master [my SlaveGetMaster]
    if {[regexp {^(?:Filter6-1|Filter6|fs1.*)$} [$master ConfigGetName]]} {
      $master variable FH
      puts $FH [my ReadSTR]
      flush $FH
    } else {
      my ProxyForward $master
    }
    my SendRETURN
  }

  method EXIT {} {
    my Exit
  }

  method ERR1 {} {
    # simulate a scripting BUG
    MkErrorC SetEXIT [self]
  }

  method SOEX {} {
    [my ErrorFORMAT] SetEXIT
  }

  method FilterIn {} {
    my StorageExport
    my SendRETURN
  }

  method FilterEvent {} {
    if {[my StorageCount] == 0} {
      # no data -> nothing to do
      [my ErrorFORMAT] SetCONTINUE
    } else {
      try {
        # with data -> try to send
        set ftr [my SlaveGetFilter]
        # read package from storage
        set Id  [my StorageImport]
  #my StorageLog
  #my LogC "StorageLog-id = $Id\n"
        # forward the entire BDY data to the ftr-target
        try {
          my ProxyForward $ftr
        } trap {MkExceptionC} {errorMessage} {
          set err [my StorageErrCnt $Id]
          if {$err <= 3} {
            my StorageDecrRef $Id
            return
          } else {
            error $errorMessage $::errorInfo $::errorCode
          }
        } trap * {} {
          error $errorMessage $::errorInfo $::errorCode
        }
      } on error {} {
        # on "error" do the following:
        my ErrorCatch
        # on "normal-error" -> write message to file and ignore
        # continue and delete data in next step
        Filter6 errorWrite [self]
      }
      # on "success" or on "error" delete item from storage
      my StorageDelete $Id
    }
  }
}

# [error_example]
tclmsgque::MqMsgque Main {
  set srv [[MqFactoryC Add Filter6] New]
  try {
    $srv LinkCreate {*}$argv
    $srv ProcessEvent MQ_WAIT_FOREVER
  } on error {} {
    $srv ErrorCatch
  } finally {
    $srv Exit
  }
}
# [error_example]