Beta Shell v2.0

File Manager

~ /usr/share/perl5/vendor_perl/POE/Test/Loops

Name	Size	Perms	Modified	Actions
[ .. / .. ]
00_info.pm	791 B	-rw-r--r--	2014-11-03 18:39:14	Edit Del
all_errors.pm	10.01 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
comp_tcp.pm	7.17 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
comp_tcp_concurrent.pm	8.32 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
connect_errors.pm	2.27 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_alarms.pm	14.48 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_aliases.pm	3.63 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_detach.pm	7.54 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_run_returns.pm	551 B	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_selects.pm	6.58 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_sig_child.pm	5.44 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_signals.pm	5.89 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
k_signals_rerun.pm	3.21 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
sbk_signal_init.pm	936 B	-rw-r--r--	2014-11-03 18:39:14	Edit Del
ses_nfa.pm	8.67 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
ses_session.pm	17.2 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_accept.pm	2.95 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_curses.pm	2.76 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_readline.pm	10.51 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_readwrite.pm	12.19 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_run.pm	17.98 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_run_size.pm	2.15 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_sf_ipv6.pm	5.18 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_sf_tcp.pm	5.19 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_sf_udp.pm	6.19 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_sf_unix.pm	6.72 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
wheel_tail.pm	8.79 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_kogman_sig_order.pm	10.69 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_leolo_wheel_run.pm	3.37 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_merijn_sigchld_system.pm	2.69 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_rt39872_sigchld.pm	4.05 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_rt39872_sigchld_stop.pm	3.39 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_rt53302_fh_watchers.pm	2.95 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_rt54319_bazerka_followtail.pm	1.97 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
z_steinert_signal_integrity.pm	1.51 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del

Editing: comp_tcp.pm (7.17 KB)

#!/usr/bin/perl -w
# vim: ts=2 sw=2 expandtab

# Exercise Server::TCP and later, when it's available, Client::TCP.

use strict;
use lib qw(./mylib ../mylib);

BEGIN {
  unless (-f "run_network_tests") {
    print "1..0 # Skip Network access (and permission) required to run this test\n";
    CORE::exit();
  }
}

use Test::More tests => 34;

sub POE::Kernel::ASSERT_DEFAULT () { 1 }

BEGIN {
  package
  POE::Kernel;
  use constant TRACE_DEFAULT => exists($INC{'Devel/Cover.pm'});
}

use POE qw( Component::Server::TCP Wheel::ReadWrite Component::Client::TCP );

my ($acceptor_port, $callback_port);

# Create a server.  This one uses Acceptor to create a session of the
# program's devising.

POE::Component::Server::TCP->new(
  Port => 0,
  Address => '127.0.0.1',
  Alias => 'acceptor_server',
  Started => sub {
    use Socket qw(sockaddr_in);
    $acceptor_port = (
      sockaddr_in($_[HEAP]->{listener}->getsockname())
    )[0];
  },
  Acceptor => sub {
    my ($socket, $peer_addr, $peer_port) = @_[ARG0..ARG2];
    POE::Session->create(
      inline_states => {
        _start => sub {
          my $heap = $_[HEAP];
          $heap->{wheel} = POE::Wheel::ReadWrite->new(
            Handle       => $socket,
            InputEvent   => 'got_input',
            ErrorEvent   => 'got_error',
            FlushedEvent => 'got_flush',
          );
          pass("acceptor server got client connection");
        },
        _stop => sub {
          pass("acceptor server stopped the client session");
        },
        got_input => sub {
          my ($heap, $input) = @_[HEAP, ARG0];
          pass("acceptor server received input");
          $heap->{wheel}->put("echo: $input");
          $heap->{shutdown} = 1 if $input eq "quit";
        },
        got_error => sub {
          my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2];
          print "acceptor server got $operation error $errnum: $errstr\n";
        },
        got_flush => sub {
          my $heap = $_[HEAP];
          pass("acceptor server flushed output");
          delete $heap->{wheel} if $heap->{shutdown};
        },
      },
    );
  },
);

# Create a server.  This one uses ClientXyz to process clients instead
# of a user-defined session.

POE::Component::Server::TCP->new(
  Port => 0,
  Address => '127.0.0.1',
  Alias => 'input_server',
  ClientFilter => [ "POE::Filter::Line", Literal => "\n" ],
  Started => sub {
    use Socket qw(sockaddr_in);
    $callback_port = (
      sockaddr_in($_[HEAP]->{listener}->getsockname())
    )[0];
  },
  ClientInput => sub {
    my ($heap, $input) = @_[HEAP, ARG0];
    pass("callback server got input");
    $heap->{client}->put("echo: $input");
    $heap->{shutdown} = 1 if $input eq "quit";
  },
  ClientError => sub {
    my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2];
    print "callback server got $operation error $errnum: $errstr\n";
  },
  ClientFlushed => sub {
    pass("callback server flushed output");
  },
  ClientConnected => sub {
    pass("callback server got client connection");
  },
  ClientPreConnect => sub {
    pass("server got pre-connect callback");
    ok(fileno($_[ARG0]), "ARG0 is a socket");
    return $_[ARG0];
  },
  ClientDisconnected => sub {
    pass("callback server got client disconnected");
  },
);

# Test that the constructor of PoCo::Client::TCP is strict in what it
# accepts as valid arguments
{
  eval { POE::Component::Client::TCP->new(
    RemoteAddress => "1.2.3.4", Odd => "Elephant", "Of Arguments") };
  ok($@ =~ /odd|even/,
    "Client::TCP constructor requires even number of parameters");

  my %base_args = (
    RemoteAddress => '127.0.0.1',
    RemotePort => 31401,
    Connected => sub { },
    ConnectError => sub { },
    Disconnected => sub { },
    ServerInput => sub { },
    ServerError => sub { },
    ServerFlushed => sub { },
  );
  my $test_missing = sub {
    my ($args, $remove) = @_;
    delete $$args{$_} for @$remove;
    eval { POE::Component::Client::TCP->new( %$args ) };
    ok($@ ne '', "Client::TCP constructor requires " . join(", ", @$remove));
  };
  $test_missing->({%base_args}, ["RemoteAddress"]);
  $test_missing->({%base_args}, ["RemotePort"]);
  $test_missing->({%base_args}, ["ServerInput"]);
  my %mark_args = (%base_args,
    HighMark => 256, LowMark => 64,
    ServerHigh => sub { }, ServerLow => sub { }
  );
  $test_missing->({%mark_args}, ["LowMark", "ServerHigh", "ServerLow"]);
  $test_missing->({%mark_args}, ["HighMark", "ServerHigh", "ServerLow"]);
  $test_missing->({%mark_args}, ["HighMark", "LowMark", "ServerLow"]);
  $test_missing->({%mark_args}, ["HighMark", "LowMark", "ServerHigh"]);

  my $test_notref = sub {
    my $which = shift;
    eval { POE::Component::Client::TCP->new( %base_args,
        $which => "Not a reference" ) };
    ok($@ =~ /$which.*reference/i,
      "Client::TCP constructor requires $which to be a reference");
  };
  $test_notref->("InlineStates");
  $test_notref->("PackageStates");
  $test_notref->("ObjectStates");

  eval { POE::Component::Client::TCP->new( %base_args,
      SessionParams => sub { "Not an array reference" }) };
  ok($@ =~ /SessionParams/,
    "Client::TCP constructor requires SessionParams to be an array reference");
}

# A client to connect to acceptor_server.

POE::Component::Client::TCP->new(
  RemoteAddress => '127.0.0.1',
  RemotePort    => $acceptor_port,

  PreConnect => sub {
    pass("acceptor pre connect");
    ok(fileno($_[ARG0]), "acceptor has a socket");
    return $_[ARG0];
  },

  Connected => sub {
    pass("acceptor client connected");
    $_[HEAP]->{server}->put( "quit" );
  },

  ConnectError => sub {
    my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2];
    print "acceptor client got $operation error $errnum: $errstr\n";
  },

  Disconnected => sub {
    pass("acceptor client disconnected");
    $_[KERNEL]->post( acceptor_server => 'shutdown' );
  },

  ServerInput => sub {
    my ($heap, $input) = @_[HEAP, ARG0];
    pass("acceptor client got input");
  },

  ServerError => sub {
    my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2];
    ok(
      ($operation eq "read") && ($errnum == 0),
      "acceptor client got read error 0 (EOF)"
    );
  },

  ServerFlushed => sub {
    pass("acceptor client flushed output");
  },
);

# A client to connect to input_server.

POE::Component::Client::TCP->new(
  RemoteAddress => '127.0.0.1',
  RemotePort    => $callback_port,
  Filter => [ "POE::Filter::Line", Literal => "\n" ],

  Connected => sub {
    pass("callback client connected");
    $_[HEAP]->{server}->put( "quit" );
  },

  ConnectError => sub {
    my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2];
    print "callback client got $operation error $errnum: $errstr\n";
  },

  Disconnected => sub {
    pass("callback client disconnected");
    $_[KERNEL]->post( input_server => 'shutdown' );
  },

  ServerInput => sub {
    my ($heap, $input) = @_[HEAP, ARG0];
    pass("callback client got input");
  },

  ServerError => sub {
    my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0..ARG2];
    ok(
      ($operation eq "read") && ($errnum == 0),
      "callback client got read error 0 (EOF)"
    );
  },

  ServerFlushed => sub {
    pass("callback client flushed output");
  },
);

# Run the tests.

POE::Kernel->run();

1;