view release on metacpan or  search on metacpan

t/anyevent_websocket_connection.t  view on Meta::CPAN

use utf8;
use lib 't/lib';
use Test2::Plugin::EV;
use Test2::Plugin::AnyEvent::Timeout;
use Test2::V0 -no_srand => 1;
use Test2::Tools::WebSocket::Connection qw( create_connection_pair create_connection_and_handle );
use AnyEvent::WebSocket::Connection;

subtest 'send' => sub {

  my($x,$y) = create_connection_pair;

  my $round_trip = sub {

    my($message) = @_;

    my $done = AnyEvent->condvar;

    $y->on(next_message => sub {
      my(undef, $message) = @_;
      $done->send($message);
    });

    $x->send($message);

    $done->recv;

  };

  subtest 'string' => sub {

    is(
      $round_trip->('hello world'),
      object {
        call body => 'hello world';
      },
    );
  };

  require AnyEvent::WebSocket::Message;

  subtest 'message object' => sub {

    is(
      $round_trip->(AnyEvent::WebSocket::Message->new(
        body => 'And another one',
      )),
      object {
        call body => 'And another one';
      },
    );

  };

  subtest 'is_text' => sub {

    is(
      $round_trip->(AnyEvent::WebSocket::Message->new(
        opcode => 1,
        body   => 'xx',
      )),
      object {
        call body => 'xx';
        call is_text => T();
        call is_binary => F();
      },
    );

  };


  subtest 'is_binary' => sub {

    is(
      $round_trip->(AnyEvent::WebSocket::Message->new(
        opcode => 2,
        body   => 'yy',
      )),
      object {
        call body => 'yy';
        call is_text => F();
        call is_binary => T();
      },
    );

  };

  subtest 'ping' => sub {

    skip_all 'no pong callback... yet';

    $x->send(
      AnyEvent::WebSocket::Message->new(
        opcode => 9,
        body   => 'zz',
      )
    );

  };

  {
    my @test_data = (
      {label => "single character", data => "a"},
      {label => "5k bytes", data => "a" x 5000},
      {label => "empty", data => ""},
      {label => "0", data => 0},
      {label => "utf8 charaters", data => 'ＵＴＦ８ ＷＩＤＥ ＣＨＡＲＡＣＴＥＲＳ'},
    );

    foreach my $case (@test_data)
    {
      subtest $case->{label} => sub {
        is(
          $round_trip->($case->{data}),
          object {
            call decoded_body => $case->{data};
          },
          'string'
        );
        is(
          $round_trip->(AnyEvent::WebSocket::Message->new(body => $case->{data})),
          object {
            call decoded_body => $case->{data};
          },
          'object'
        );
      };
    }
  }

  subtest 'close' => sub {

    my $done = AnyEvent->condvar;

    $y->on(finish => sub {
      $done->send;
    });

    $x->send(
      AnyEvent::WebSocket::Message->new(
        opcode => 8,
        body   => pack('naa', 1005, 'b','b'),
      ),
    );

    $done->recv;

    is(
      $y,
      object {
        call close_code   => 1005;
        call close_reason => 'bb';
      },
    );
  };

};

subtest 'masked attribute should control whether the frames sent by the Connection are masked or not' => sub {

  foreach my $masked (0,1)
  {

    subtest "masked = $masked" => sub {
      my ($x_conn, $y_handle) = create_connection_and_handle({masked => $masked});
      my $cv_finish = AnyEvent->condvar;
      $y_handle->on_read(sub {