/xt/v6.t

  1use Test::More;
  2use strict; use warnings FATAL => 'all';
  3
  4use POE;
  5
  6use_ok( 'POEx::IRC::Backend' );
  7use_ok( 'IRC::Message::Object', 'ircmsg' );
  8
  9my $expected = {
 10  'got listener_created' => 1,
 11  'got connector_open'   => 1,
 12  'got listener_open'    => 1,
 13  'got listener_removed' => 1,
 14  'got ircsock_input'    => 3,
 15};
 16my $got = {};
 17
 18
 19POE::Session->create(
 20  package_states => [
 21    main => [ qw/
 22      _start
 23      shutdown
 24      ircsock_registered
 25
 26      ircsock_connector_open
 27      ircsock_listener_created
 28      ircsock_listener_removed
 29      ircsock_listener_failure
 30      ircsock_listener_open
 31      ircsock_input
 32    / ],
 33  ],
 34);
 35
 36sub _start {
 37  $_[HEAP] = new_ok( 'POEx::IRC::Backend' );
 38  my ($k, $backend) = @_[KERNEL, HEAP];
 39  $k->delay( shutdown => 30 => 'timeout' );
 40  $backend->spawn;
 41  $k->post( $backend->session_id, 'register' );
 42  $backend->create_listener(
 43    protocol => 6,
 44    bindaddr => '::0',
 45    port     => 0,
 46  );
 47}
 48
 49sub shutdown {
 50  my ($k, $backend) = @_[KERNEL, HEAP];
 51  $k->alarm_remove_all;
 52  $k->post( $backend->session_id, 'shutdown' );
 53  if ($_[ARG0] && $_[ARG0] eq 'timeout') {
 54    fail("Timed out");
 55    diag explain $got;
 56  }
 57}
 58
 59sub ircsock_registered {
 60}
 61
 62sub ircsock_listener_created {
 63  my ($k, $backend) = @_[KERNEL, HEAP];
 64  my $listener = $_[ARG0];
 65
 66  $got->{'got listener_created'}++;
 67
 68  isa_ok( $listener, 'POEx::IRC::Backend::Listener' );
 69
 70  $backend->create_connector(
 71    remoteaddr => $listener->addr,
 72    remoteport => $listener->port,
 73  );
 74}
 75
 76sub ircsock_connector_open {
 77  my ($k, $backend) = @_[KERNEL, HEAP];
 78  my $conn = $_[ARG0];
 79
 80  ## OK, technically a Connector that acts like a client
 81  ## ought to have a backend with a 'colonify => 0' filter
 82
 83  $got->{'got connector_open'}++;
 84
 85  $backend->send(
 86    {
 87      command => 'CONNECTOR',
 88      params  => [ 'testing' ],
 89    },
 90    $conn->wheel_id
 91  );
 92
 93  $backend->send( ircmsg( raw_line => ':test CONNECTOR :testing' ),
 94    $conn->wheel_id
 95  );
 96}
 97
 98sub ircsock_listener_removed {
 99  my ($k, $backend) = @_[KERNEL, HEAP];
100  my $listener = $_[ARG0];
101
102  $got->{'got listener_removed'}++;
103
104  $k->yield( shutdown => 1 )
105}
106
107sub ircsock_listener_failure {
108  my ($op, $errno, $errstr) = @_[ARG1 .. ARG3];
109  BAIL_OUT("Failed listener creation: $op ($errno) $errstr");
110}
111
112sub ircsock_listener_open {
113  my ($k, $backend) = @_[KERNEL, HEAP];
114  my ($conn, $listener) = @_[ARG0 .. $#_];
115
116  $got->{'got listener_open'}++;
117
118  $backend->send(
119    ircmsg(
120      prefix  => 'listener',
121      command => 'test',
122      params  => [ 'testing', 'stuff' ],
123    ),
124    $conn->wheel_id
125  );
126}
127
128sub ircsock_input {
129  my ($k, $backend) = @_[KERNEL, HEAP];
130  my ($conn, $ev)   = @_[ARG0 .. $#_];
131
132  if ($ev->params->[0] eq 'testing') {
133    $got->{'got ircsock_input'}++;
134  }
135
136  ## FIXME test ->disconnect() behavior
137
138  if ($got->{'got ircsock_input'} == $expected->{'got ircsock_input'}) {
139    ## Call for a listener removal to test listener_removed
140    $backend->remove_listener(
141      addr => '::0',
142    );
143  }
144}
145
146
147$poe_kernel->run;
148
149TEST: for my $name (keys %$expected) {
150  ok( defined $got->{$name}, "have result for '$name'")
151    or next TEST;
152  cmp_ok( $got->{$name}, '==', $expected->{$name}, 
153    "correct result for '$name'"
154  );
155}
156
157done_testing;