Merge pull request #2 from vti/master

Merge with origin.

Changes

@@ -2,6 +2,11 @@ Revision history for perl module Protocol::WebSocket
 
 {{$NEXT}}
 
+0.17 2014-04-09T08:12:01Z
+
+ - perl 5.8 unpack fix (Graham Ollis)
+ - doc and test fixes (Michal Špaček)
+
 0.16 2014-01-07T20:33:59Z
 
  - just meta files update

lib/Protocol/WebSocket.pm

@@ -3,7 +3,7 @@ package Protocol::WebSocket;
 use strict;
 use warnings;
 
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 
 use Protocol::WebSocket::Frame;
 use Protocol::WebSocket::Handshake::Client;
@@ -13,6 +13,8 @@ use Protocol::WebSocket::URL;
 1;
 __END__
 
+=encoding UTF-8
+
 =head1 NAME
 
 Protocol::WebSocket - WebSocket protocol
@@ -67,27 +69,39 @@ attribute to an appropriate value.
 L<Protocol::WebSocket> itself does not contain any code and cannot be used
 directly. Instead the following modules should be used:
 
-=head2 L<Protocol::WebSocket::Handshake::Server>
+=head2 High-level modules
+
+=head3 L<Protocol::WebSocket::Server>
+
+Server helper class.
+
+=head3 L<Protocol::WebSocket::Client>
+
+Client helper class.
+
+=head2 Low-level modules
+
+=head3 L<Protocol::WebSocket::Handshake::Server>
 
 Server handshake parser and constructor.
 
-=head2 L<Protocol::WebSocket::Handshake::Client>
+=head3 L<Protocol::WebSocket::Handshake::Client>
 
 Client handshake parser and constructor.
 
-=head2 L<Protocol::WebSocket::Frame>
+=head3 L<Protocol::WebSocket::Frame>
 
 WebSocket frame parser and constructor.
 
-=head2 L<Protocol::WebSocket::Request>
+=head3 L<Protocol::WebSocket::Request>
 
 Low level WebSocket request parser and constructor.
 
-=head2 L<Protocol::WebSocket::Response>
+=head3 L<Protocol::WebSocket::Response>
 
 Low level WebSocket response parser and constructor.
 
-=head2 L<Protocol::WebSocket::URL>
+=head3 L<Protocol::WebSocket::URL>
 
 Low level WebSocket url parser and constructor.
 
@@ -120,13 +134,17 @@ Toshio Ito (debug-ito)
 
 Neil Bowers
 
+Michal Špaček
+
+Graham Ollis
+
 =head1 AUTHOR
 
 Viacheslav Tykhanovskyi, C<vti@cpan.org>.
 
 =head1 COPYRIGHT
 
-Copyright (C) 2010-2013, Viacheslav Tykhanovskyi.
+Copyright (C) 2010-2014, Viacheslav Tykhanovskyi.
 
 This program is free software, you can redistribute it and/or modify it under
 the same terms as Perl 5.10.

lib/Protocol/WebSocket/Client.pm

@@ -22,6 +22,7 @@ sub new {
 
     $self->{version} = $params{version};
 
+    $self->{on_connect} = $params{on_connect};
     $self->{on_write} = $params{on_write};
     $self->{on_frame} = $params{on_frame};
     $self->{on_eof}   = $params{on_eof};
@@ -34,7 +35,8 @@ sub new {
     return $self;
 }
 
-sub url { shift->{url} }
+sub url     { shift->{url} }
+sub version { shift->{version} }
 
 sub on {
     my $self = shift;
@@ -57,6 +59,8 @@ sub read {
             $self->{on_error}->($self, $hs->error);
             return $self;
         }
+
+        $self->{on_connect}->($self) if $self->{on_connect} && $hs->is_done;
     }
 
     if ($hs->is_done) {
@@ -143,7 +147,12 @@ Protocol::WebSocket::Client - WebSocket client
     # Sends a correct handshake header
     $client->connect;
 
-    $client->write('hi there');
+    # Register on connect handler
+    $client->on(
+        connect => sub {
+            $client->write('hi there');
+        }
+    );
 
     # Parses incoming data and on every frame calls on_read
     $client->read(...data from socket...);

lib/Protocol/WebSocket/Frame.pm

@@ -163,7 +163,7 @@ sub next_bytes {
             $bits =~ s{^.}{0};
 
             # Can we handle 64bit numbers?
-            if ($Config{ivsize} <= 4 || $Config{longsize} < 8) {
+            if ($Config{ivsize} <= 4 || $Config{longsize} < 8 || $] < 5.010) {
                 $bits = substr($bits, 32);
                 $payload_len = unpack 'N', pack 'B*', $bits;
             }

t/client.t

@@ -4,6 +4,8 @@ use strict;
 use warnings;
 
 use Test::More;
+use IO::Handle;
+use Protocol::WebSocket::Handshake::Server;
 
 use_ok 'Protocol::WebSocket::Client';
 
@@ -18,6 +20,45 @@ subtest 'write handshake on connect' => sub {
     like $written, qr/Upgrade: WebSocket/;
 };
 
+subtest 'call on_connect on connect' => sub {
+    my $client = Protocol::WebSocket::Client->new(url => 'ws://localhost:8080');
+
+    $client->on(write => sub { });
+
+    my $connected;
+    $client->on(
+        connect => sub {
+            $connected++;
+        }
+    );
+
+    $client->connect;
+
+    _recv_server_handshake($client);
+
+    ok $connected;
+};
+
+subtest 'call on_read on new data' => sub {
+    my $client = Protocol::WebSocket::Client->new(url => 'ws://localhost:8080');
+
+    my $read = '';
+    $client->on(write => sub { });
+    $client->on(read => sub { $read .= $_[1] });
+
+    $client->connect;
+
+    _recv_server_handshake($client);
+
+    my $frame = Protocol::WebSocket::Frame->new(
+        version => $client->version,
+        buffer  => 'hello'
+    );
+    $client->read($frame->to_bytes);
+
+    is $read, 'hello';
+};
+
 subtest 'write close frame on disconnect' => sub {
     my $client = Protocol::WebSocket::Client->new(url => 'ws://localhost:8080');
 
@@ -40,4 +81,25 @@ subtest 'call on_write on write' => sub {
     isnt $written, '';
 };
 
+sub _recv_server_handshake {
+    my ($client) = @_;
+
+    open my $fh, '<', \'' or die $!;
+    my $io = IO::Handle->new;
+    $io->fdopen(fileno($fh), "r");
+    my $hs = Protocol::WebSocket::Handshake::Server->new_from_psgi(
+        SCRIPT_NAME                => '',
+        PATH_INFO                  => '/chat',
+        HTTP_UPGRADE               => 'websocket',
+        HTTP_CONNECTION            => 'Upgrade',
+        HTTP_HOST                  => 'server.example.com',
+        HTTP_SEC_WEBSOCKET_ORIGIN  => 'http://example.com',
+        HTTP_SEC_WEBSOCKET_KEY     => 'dGhlIHNhbXBsZSBub25jZQ==',
+        HTTP_SEC_WEBSOCKET_VERSION => 13,
+    );
+    $hs->parse($io);
+
+    $client->read($hs->to_string);
+}
+
 done_testing;