File Coverage

blib/lib/Net/Async/WebSocket/Client.pm
Criterion Covered Total %
statement 69 78 88.4
branch 8 16 50.0
condition 3 12 25.0
subroutine 16 20 80.0
pod 3 3 100.0
total 99 129 76.7


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2010-2017 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::WebSocket::Client;
7              
8 3     3   292173 use strict;
  3         21  
  3         94  
9 3     3   16 use warnings;
  3         6  
  3         85  
10 3     3   24 use base qw( Net::Async::WebSocket::Protocol );
  3         11  
  3         1032  
11 3     3   93 use 5.010; # //
  3         10  
12              
13             IO::Async::Notifier->VERSION( '0.63' ); # ->adopt_future
14              
15 3     3   37 use Carp;
  3         8  
  3         191  
16              
17 3     3   27 use Scalar::Util qw( blessed );
  3         10  
  3         162  
18              
19 3     3   1696 use URI;
  3         14055  
  3         395  
20              
21             BEGIN {
22             eval {
23 3         483 require URI::wss;
24 3 50   3   13 } or do {
25             # In case URI doesn't know that ws:// and wss:// URIs use host/port
26 3         1337 require URI::_server;
27              
28 3         19752 @URI::ws::ISA = qw( URI::_server );
29 3     0   23 *URI::ws::default_port = sub { 80 };
  0         0  
30              
31 3         40 @URI::wss::ISA = qw( URI::_server );
32 3     0   20 *URI::wss::default_port = sub { 443 };
  0         0  
33 3     0   15 *URI::wss::secure = sub { 1 };
  0         0  
34             };
35              
36             # We also need to support ->resource_name, which the CPAN module does not
37             # understand as of 2017-01-01
38 3     3   25 no warnings 'once';
  3         7  
  3         274  
39             *URI::wss::resource_name = sub {
40             shift->path_query
41 3 50   0   163 } unless URI::wss->can( "resource_name" );
  0         0  
42             }
43              
44             our $VERSION = '0.13';
45              
46 3     3   1413 use Protocol::WebSocket::Handshake::Client;
  3         54648  
  3         1578  
47              
48             =head1 NAME
49              
50             C - connect to a WebSocket server using
51             C
52              
53             =head1 SYNOPSIS
54              
55             use IO::Async::Loop;
56             use Net::Async::WebSocket::Client;
57              
58             my $client = Net::Async::WebSocket::Client->new(
59             on_text_frame => sub {
60             my ( $self, $frame ) = @_;
61             print $frame;
62             },
63             );
64              
65             my $loop = IO::Async::Loop->new;
66             $loop->add( $client );
67              
68             $client->connect(
69             url => "ws://$HOST:$PORT/",
70             )->then( sub {
71             $client->send_text_frame( "Hello, world!\n" );
72             })->get;
73              
74             $loop->run;
75              
76             =head1 DESCRIPTION
77              
78             This subclass of L connects to a WebSocket
79             server to establish a WebSocket connection for passing frames.
80              
81             =cut
82              
83             sub new
84             {
85 3     3 1 8328 my $class = shift;
86 3         34 return $class->SUPER::new(
87             masked => 1,
88             @_,
89             );
90             }
91              
92             =head1 METHODS
93              
94             The following methods documented with a trailing call to C<< ->get >> return
95             L instances.
96              
97             =cut
98              
99             sub _do_handshake
100             {
101 3     3   9 my $self = shift;
102 3         13 my %params = @_;
103              
104             my $hs = Protocol::WebSocket::Handshake::Client->new(
105             url => $params{url},
106             req => $params{req},
107 3         35 );
108              
109 3         828 $self->debug_printf( "HANDSHAKE start" );
110 3         27 $self->write( $hs->to_string );
111              
112 3         1339 my $f = $self->loop->new_future;
113             $self->SUPER::configure( on_read => sub {
114 2     2   9410 my ( undef, $buffref, $closed ) = @_;
115              
116 2         14 $hs->parse( $$buffref ); # modifies $$buffref
117              
118 2 50       780 if( $hs->is_done ) {
119 2         36 $self->debug_printf( "HANDSHAKE done" );
120 2         14 $self->SUPER::configure( on_read => undef );
121              
122 2         188 $f->done( $self );
123             }
124              
125 2         193 return 0;
126 3         1317 } );
127              
128 3         270 return $f;
129             }
130              
131             =head2 connect
132              
133             $self->connect( %params )->get
134              
135             Connect to a WebSocket server. Takes the following named parameters:
136              
137             =over 8
138              
139             =item url => STRING
140              
141             URL to provide to WebSocket handshake. This is also used to infer the host and
142             service name (port number) if not otherwise supplied.
143              
144             =item req => Protocol::WebSocket::Request
145              
146             Optional. If provided, gives the L instance used
147             for performing the handshake.
148              
149             =back
150              
151             The returned L returns the client instance itself, making it useful
152             in chaining constructors.
153              
154             =head2 connect (void)
155              
156             $self->connect( %params )
157              
158             When not returning a C, the following additional parameters provide
159             continuations:
160              
161             =over 8
162              
163             =item on_connected => CODE
164              
165             CODE reference to invoke when the handshaking is complete.
166              
167             =back
168              
169             =cut
170              
171             sub connect
172             {
173 1     1 1 284 my $self = shift;
174 1         6 my %params = @_;
175              
176 1 50       12 if( my $url = $params{url} ) {
177 1 50 33     17 $url = URI->new( $url ) unless blessed $url and $url->isa( "URI" );
178              
179 1   33     304 $params{host} //= $url->host;
180 1   33     4 $params{service} //= $url->port;
181              
182 1 50       7 if( $url->secure ) {
183 0         0 require IO::Async::SSL;
184 0         0 push @{ $params{extensions} }, qw( SSL );
  0         0  
185 0   0     0 $params{SSL_hostname} //= $url->host;
186             }
187             }
188              
189 1         7 my $on_connected = delete $params{on_connected};
190              
191             my $f = $self->SUPER::connect( %params )->then( sub {
192 1     1   545 my ( $self ) = @_;
193              
194 1         15 $self->_do_handshake( %params );
195 1         10 });
196              
197 1 50       24983 $f->on_done( $on_connected ) if $on_connected;
198              
199 1 50       23 return $f if defined wantarray;
200              
201 0         0 $self->adopt_future( $f );
202             }
203              
204             =head2 connect_handle
205              
206             $client->connect_handle( $handle, %params )->get
207              
208             Sets the read and write handles to the IO reference given, then performs the
209             initial handshake using the parameters given. These are as for C.
210              
211             =cut
212              
213             sub connect_handle
214             {
215 2     2 1 1409 my $self = shift;
216 2         18 my ( $handle, %params ) = @_;
217              
218 2         23 $self->set_handle( $handle );
219              
220 2         667 $self->_do_handshake( %params );
221             }
222              
223             =head1 AUTHOR
224              
225             Paul Evans
226              
227             =cut
228              
229             0x55AA;