/xt/v6.t

https://bitbucket.org/avenj/poex-irc-backend · Raku · 157 lines · 120 code · 33 blank · 4 comment · 11 complexity · 7b2de8c565cc88d06db1e08e9527f9be MD5 · raw file

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