La séptima vida

...o el gato así lo espera/teme

A test for Device::Modbus::TCP

Following almost the same tricks as for Device::Modbus::RTU (see the previous article), Device::Modbus::TCP now has a test file which creates both a server and a client, establishes a connection between them, and then looks into the logged messages of the server.

The program forks as it starts. This way, the parent plays the client while the child starts the pre-forking servers:

# Fork. Child builds a server who dies after a couple of seconds
$|++;
my $pid = fork;
unless (defined $pid && $pid) {
    # We are the child. Start a server.
    # Send an alarm signal in two seconds.
    # Then, send a SIGINT to stop the server.
    $SIG{ALRM} = sub { kill 2, $$ };
    alarm(2);

    my $unit   = Test::Unit->new( id => 3 );
    my $server = Device::Modbus::TCP::Server->new(
        port      => 6545,
        log_level => 4,
        log_file  => "/tmp/log$$"
    );
    $server->add_server_unit($unit);
    $server->start;
}

Note that the server is listening at port 6545. Port 502, the standard for Modbus, is reserved and you would need superpowers to start the test in that port (and you may even have a server already listening for real Modbus connections!).

As noted above, the child will start the pre-forking servers. It is set to send an alarm signal to itself after 2 seconds, which will then send a SIGINT for the servers to shut down.

Server output is written to a file in the /tmp directory, so that it can be later analyzed.

On the other hand, the client does its thing like this:

my $client = Device::Modbus::TCP::Client->new( port => 6545 );
isa_ok $client, 'Device::Modbus::Client';

my $req = $client->read_holding_registers(
    unit     => 3,
    address  => 2,
    quantity => 1
);
isa_ok $req, 'Device::Modbus::Request';

sleep 1;

eval {
    $client->send_request($req);
};
ok !$@, 'Survived sending request to forked server';

SKIP : {
    skip "Client just died($@)", 2, if $@;
    
    my $adu = $client->receive_response;
    isa_ok $adu, 'Device::Modbus::TCP::ADU';

    is_deeply $adu->values, [6], 'Value returned from server is correct';

    $client->disconnect;
}

is wait(), $pid, "Waited for child whose pid was $pid" ;

This part creates a client, prepares a simple request, and sends it. Have you seen that it sleeps for one second before sending the request? This is to give some time for the server to start. Without this, the connection to the server is not successful and the client dies. In this sad case, the rest of the client-side tests would not be needed and are thus skipped.

If everything goes well, the server will return the requested value, which is number 6 in this case. But hey, it did exercise a good deal of things in our server code.

After examining the client's point of view, we turn our attention to the server logs. The log file is slurped into memory and then some signature lines are tested:

# Now check the log of the server. Pull everything into a variable
my $log;
{
    local $/ = undef;
    open my $server_log, '<', "/tmp/log$pid"
        or die "Unable to open log file: $!";
    $log = <$server_log>;
    close $server_log;
}

like $log, qr/Device::Modbus::TCP::Server .*? starting!/,
    'Server logged its starting line';
like $log, qr/^Binding to TCP port 6545/m,
    'Logged port binding step';
like $log, qr/^Starting "5" children/m,
    'Logged the default number of preforked children';
like $log, qr/^Received message from 127.0.0.1/m,
    'Logged the reception of our message';
like $log, qr/ address: <2> quantity: <1>/,
    'Message interpreted correctly';
like $log, qr/^Match was successful/m,
    'Match succeeded';
like $log, qr/Server closing!$/m,
    'Server closed';

And that is it. Device::Modbus::TCP now includes a test that exercises both the client and the server.