From df462e7c7735960f87b3837db36ef5716ff5ad23 Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Tue, 8 Apr 2014 13:37:03 -0400 Subject: [PATCH 1/4] perl 5.8 does not support '>' modifier for unpack --- lib/Protocol/WebSocket/Frame.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Protocol/WebSocket/Frame.pm b/lib/Protocol/WebSocket/Frame.pm index eb64a0b..f92a5f1 100644 --- a/lib/Protocol/WebSocket/Frame.pm +++ b/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; } From f7273d3700f49497696e305411c0b5462127ae8b Mon Sep 17 00:00:00 2001 From: vti Date: Tue, 8 Apr 2014 23:10:46 +0300 Subject: [PATCH 2/4] new version --- Changes | 3 +++ lib/Protocol/WebSocket.pm | 10 ++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index c3489aa..3558e51 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,9 @@ Revision history for perl module Protocol::WebSocket {{$NEXT}} + - 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 diff --git a/lib/Protocol/WebSocket.pm b/lib/Protocol/WebSocket.pm index 7be94c1..f3f8a6f 100644 --- a/lib/Protocol/WebSocket.pm +++ b/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 @@ -120,13 +122,17 @@ Toshio Ito (debug-ito) Neil Bowers +Michal Špaček + +Graham Ollis + =head1 AUTHOR Viacheslav Tykhanovskyi, C. =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. From 3ad0622eafb92dc22da260002f4b6872d81d0cab Mon Sep 17 00:00:00 2001 From: vti Date: Wed, 9 Apr 2014 11:12:21 +0300 Subject: [PATCH 3/4] Checking in changes prior to tagging of version 0.17. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Changelog diff is: diff --git a/Changes b/Changes index 3558e51..e57496b 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,8 @@ 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) --- Changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Changes b/Changes index 3558e51..e57496b 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,8 @@ 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) From 9259e887bbab33f99aed55a1f1bd7201e676387e Mon Sep 17 00:00:00 2001 From: vti Date: Wed, 14 May 2014 20:54:08 +0300 Subject: [PATCH 4/4] on_connect client handler & more tests --- lib/Protocol/WebSocket.pm | 24 +++++++++---- lib/Protocol/WebSocket/Client.pm | 13 +++++-- t/client.t | 62 ++++++++++++++++++++++++++++++++ 3 files changed, 91 insertions(+), 8 deletions(-) diff --git a/lib/Protocol/WebSocket.pm b/lib/Protocol/WebSocket.pm index f3f8a6f..2460838 100644 --- a/lib/Protocol/WebSocket.pm +++ b/lib/Protocol/WebSocket.pm @@ -69,27 +69,39 @@ attribute to an appropriate value. L itself does not contain any code and cannot be used directly. Instead the following modules should be used: -=head2 L +=head2 High-level modules + +=head3 L + +Server helper class. + +=head3 L + +Client helper class. + +=head2 Low-level modules + +=head3 L Server handshake parser and constructor. -=head2 L +=head3 L Client handshake parser and constructor. -=head2 L +=head3 L WebSocket frame parser and constructor. -=head2 L +=head3 L Low level WebSocket request parser and constructor. -=head2 L +=head3 L Low level WebSocket response parser and constructor. -=head2 L +=head3 L Low level WebSocket url parser and constructor. diff --git a/lib/Protocol/WebSocket/Client.pm b/lib/Protocol/WebSocket/Client.pm index af284d1..c839bf1 100644 --- a/lib/Protocol/WebSocket/Client.pm +++ b/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...); diff --git a/t/client.t b/t/client.t index 6974950..ef693d4 100644 --- a/t/client.t +++ b/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;