Test::TCP

Test::TCP - 测试 TCP 程序。「Test::TCP - testing TCP program」

Github stars Tracking Chart

NAME

Test::TCP - testing TCP program

SYNOPSIS

use Test::TCP;

my $server = Test::TCP->new(
    listen => 1,
    code => sub {
        my $socket = shift;
        ...
    },
);
my $client = MyClient->new(host => '127.0.0.1', port => $server->port);
undef $server; # kill child process on DESTROY

If using a server that can only accept a port number, e.g. memcached:

use Test::TCP;

my $memcached = Test::TCP->new(
    code => sub {
        my $port = shift;

        exec $bin, '-p' => $port;
        die "cannot execute $bin: $!";
    },
);
my $memd = Cache::Memcached->new({servers => ['127.0.0.1:' . $memcached->port]});
...

N.B.: This is vulnerable to race conditions, if another process binds
to the same port after Net::EmptyPort found it available.

And functional interface is available:

use Test::TCP;
test_tcp(
    listen => 1,
    client => sub {
        my ($port, $server_pid) = @_;
        # send request to the server
    },
    server => sub {
        my $socket = shift;
        # run server, calling $socket->accept
    },
);

test_tcp(
    client => sub {
        my ($port, $server_pid) = @_;
        # send request to the server
    },
    server => sub {
        my $port = shift;
        # run server, binding to $port
    },
);

DESCRIPTION

Test::TCP is a test utility to test TCP/IP-based server programs.

METHODS

  • test_tcp

    Functional interface.

      test_tcp(
          listen => 1,
          client => sub {
              my $port = shift;
              # send request to the server
          },
          server => sub {
              my $socket = shift;
              # run server
          },
          # optional
          host => '127.0.0.1', # specify '::1' to test using IPv6
          port => 8080,
          max_wait => 3, # seconds
      );
    

    If listen is false, server is instead passed a port number that
    was free before it was called.

  • wait_port

      wait_port(8080);
    

    Waits for a particular port is available for connect.

Object Oriented interface

  • my $server = Test::TCP->new(%args);

    Create new instance of Test::TCP.

    Arguments are following:

    • $args{auto_start}: Boolean

      Call $server->start() after create instance.

      Default: true

    • $args{code}: CodeRef

      The callback function. Argument for callback function is:
      $code->($socket) or $code->($port),
      depending on the value of listen.

      This parameter is required.

    • $args{max_wait} : Number

      Will wait for at most $max_wait seconds before checking port.

      See also Net::EmptyPort.

      Default: 10

    • $args{listen} : Boolean

      If true, open a listening socket and pass this to the callback.
      Otherwise find a free port and pass the number of it to the callback.

  • $server->start()

    Start the server process. Normally, you don't need to call this method.

  • $server->stop()

    Stop the server process.

  • my $pid = $server->pid();

    Get the pid of child process.

  • my $port = $server->port();

    Get the port number of child process.

FAQ

  • How to invoke two servers?

    You can call test_tcp() twice!

      test_tcp(
          client => sub {
              my $port1 = shift;
              test_tcp(
                  client => sub {
                      my $port2 = shift;
                      # some client code here
                  },
                  server => sub {
                      my $port2 = shift;
                      # some server2 code here
                  },
              );
          },
          server => sub {
              my $port1 = shift;
              # some server1 code here
          },
      );
    

    Or use the OO interface instead.

      my $server1 = Test::TCP->new(code => sub {
          my $port1 = shift;
          ...
      });
      my $server2 = Test::TCP->new(code => sub {
          my $port2 = shift;
          ...
      });
    
      # your client code here.
      ...
    
  • How do you test server program written in other languages like memcached?

    You can use exec() in child process.

      use strict;
      use warnings;
      use utf8;
      use Test::More;
      use Test::TCP 1.08;
      use File::Which;
    
      my $bin = scalar which 'memcached';
      plan skip_all => 'memcached binary is not found' unless defined $bin;
    
      my $memcached = Test::TCP->new(
          code => sub {
              my $port = shift;
    
              exec $bin, '-p' => $port;
              die "cannot execute $bin: $!";
          },
      );
    
      use Cache::Memcached;
      my $memd = Cache::Memcached->new({servers => ['127.0.0.1:' . $memcached->port]});
      $memd->set(foo => 'bar');
      is $memd->get('foo'), 'bar';
    
      done_testing;
    
  • How do I use address other than "127.0.0.1" for testing?

    You can use the host parameter to specify the bind address.

      # let the server bind to "0.0.0.0" for testing
      test_tcp(
          client => sub {
              ...
          },
          server => sub {
              ...
          },
          host => '0.0.0.0',
      );
    
  • How should I write IPv6 tests?

    You should use the "can_bind" in Net::EmptyPort function to check if the program can bind to the loopback address of IPv6, as well as the host parameter of the "test_tcp" function to specify the same address as the bind address.

      use Net::EmptyPort qw(can_bind);
    
      plan skip_all => "IPv6 not available"
          unless can_bind('::1');
    
      test_tcp(
          client => sub {
              ...
          },
          server => sub {
              ...
          },
          host => '::1',
      );
    

AUTHOR

Tokuhiro Matsuno tokuhirom@gmail.com

THANKS TO

kazuhooku

dragon3

charsbar

Tatsuhiko Miyagawa

lestrrat

SEE ALSO

LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Main metrics

Overview
Name With Ownertokuhirom/Test-TCP
Primary LanguagePerl
Program languagePerl (Language Count: 2)
Platform
License:Other
所有者活动
Created At2009-03-26 04:06:45
Pushed At2024-05-23 04:16:37
Last Commit At2024-05-23 13:16:37
Release Count75
Last Release Name2.22 (Posted on )
First Release Name0.03 (Posted on 2009-03-26 13:16:49)
用户参与
Stargazers Count33
Watchers Count9
Fork Count33
Commits Count320
Has Issues Enabled
Issues Count47
Issue Open Count14
Pull Requests Count44
Pull Requests Open Count4
Pull Requests Close Count8
项目设置
Has Wiki Enabled
Is Archived
Is Fork
Is Locked
Is Mirror
Is Private