view release on metacpan or  search on metacpan

t/anyevent_websocket_client.t  view on Meta::CPAN

    $cv->recv;

  };

  # test the double standard that we can send any sized
  # frame, but will not accept large ones.
  subtest 'receive message > max_payload_size' => sub {

    my $data = 'x' x 65540;

    my $connection = $client->connect($uri)->recv;

    my $cv = AE::cv;
    $connection->on(parse_error => sub {
      my($connection, $error) = @_;
      isnt $error, '', "Error is: $error";
      $cv->send;
    });

    eval { $connection->send($data) };
    is $@, '';

    $cv->recv;

  };

};

subtest 'client connection should receive the initial message sent from server' => sub {

  my $url = start_server(
    handshake => sub {
      my $opt = { @_ };
      $opt->{hdl}->push_write(Protocol::WebSocket::Frame->new("initial message from server")->to_bytes);
    },
    message => sub {
      my $opt = { @_ };
      $opt->{hdl}->push_shutdown;
    },
  );

  my $conn = AnyEvent::WebSocket::Client->new->connect($url)->recv;
  my $cv_finish = AnyEvent->condvar;
  my @received_messages = ();
  $conn->on(each_message => sub {
    my ($conn, $message) = @_;
    push(@received_messages, $message->body);
    $conn->send("finish");

  });
  $conn->on(finish => sub {
    $cv_finish->send();
  });

  $cv_finish->recv;
  is(\@received_messages, ["initial message from server"]);

};

subtest 'callbacks can be unregistered' => sub {

  my $url = start_server(
    handshake => sub {
      my $opt = { @_ };
      $opt->{hdl}->push_write(Protocol::WebSocket::Frame->new("initial message from server")->to_bytes) for 1..10;
    },
    message => sub {
      my $opt = { @_ };
      $opt->{hdl}->push_shutdown;
    },
  );

  my $conn = AnyEvent::WebSocket::Client->new->connect($url)->recv;
  my $cv_finish = AnyEvent->condvar;
  my @received_messages = ();

  my @counters = (0,0);

  # using the returned callback
  my $cancel;
  $cancel = $conn->on( each_message => sub {
     $cancel->() if 2 == ++$counters[0];
  });

  # # using the provided coderef
  $conn->on( each_message => sub {
    $_[2]->() if 2 == ++$counters[1];
  });


  my $countdown = 10;
  $conn->on(each_message => sub {
    my ($conn, $message) = @_;
    push(@received_messages, $message->body);
    $conn->send("finish") unless --$countdown;

  });
  $conn->on(finish => sub {
    $cv_finish->send();
  });

  $cv_finish->recv;
  is(\@received_messages, [("initial message from server")x10]);

  is(\@counters, [2,2], "callbacks got unregistered after second message");

};

done_testing;