File Coverage

blib/lib/Net/Async/WebSocket/Client.pm
Criterion Covered Total %
statement 52 53 98.1
branch 5 10 50.0
condition 3 9 33.3
subroutine 12 12 100.0
pod 2 2 100.0
total 74 86 86.0


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-2015 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::WebSocket::Client;
7              
8 3     3   218036 use strict;
  3         9  
  3         80  
9 3     3   15 use warnings;
  3         6  
  3         90  
10 3     3   14 use base qw( Net::Async::WebSocket::Protocol );
  3         6  
  3         1221  
11              
12             IO::Async::Notifier->VERSION( '0.63' ); # ->adopt_future
13              
14 3     3   35 use Carp;
  3         6  
  3         176  
15              
16 3     3   14 use Scalar::Util qw( blessed );
  3         5  
  3         129  
17              
18 3     3   2612 use URI;
  3         14674  
  3         273  
19              
20             # In case URI doesn't know that ws:// and wss:// URIs use host/port
21             require URI::_server;
22             @URI::ws::ISA = ("URI::_server");
23             @URI::wss::ISA = ("URI::_server");
24              
25             our $VERSION = '0.10';
26              
27 3     3   2591 use Protocol::WebSocket::Handshake::Client;
  3         72401  
  3         1435  
28              
29             =head1 NAME
30              
31             C - connect to a WebSocket server using
32             C
33              
34             =head1 SYNOPSIS
35              
36             use IO::Async::Loop;
37             use Net::Async::WebSocket::Client;
38              
39             my $client = Net::Async::WebSocket::Client->new(
40             on_frame => sub {
41             my ( $self, $frame ) = @_;
42             print $frame;
43             },
44             );
45              
46             my $loop = IO::Async::Loop->new;
47             $loop->add( $client );
48              
49             $client->connect(
50             url => "ws://$HOST:$PORT/",
51             )->then( sub {
52             $client->send_frame( "Hello, world!\n" );
53             })->get;
54              
55             $loop->run;
56              
57             =head1 DESCRIPTION
58              
59             This subclass of L connects to a WebSocket
60             server to establish a WebSocket connection for passing frames.
61              
62             =cut
63              
64             =head1 METHODS
65              
66             The following methods documented with a trailing call to C<< ->get >> return
67             L instances.
68              
69             =cut
70              
71             sub _do_handshake
72             {
73 2     2   17 my $self = shift;
74 2         29 my %params = @_;
75              
76             my $hs = Protocol::WebSocket::Handshake::Client->new(
77             url => $params{url},
78 2         25 );
79              
80 2         518 $self->debug_printf( "HANDSHAKE start" );
81 2         14 $self->write( $hs->to_string );
82              
83 2         806 my $f = $self->loop->new_future;
84             $self->SUPER::configure( on_read => sub {
85 2     2   5958 my ( undef, $buffref, $closed ) = @_;
86              
87 2         16 $hs->parse( $$buffref ); # modifies $$buffref
88              
89 2 50       689 if( $hs->is_done ) {
90 2         37 $self->debug_printf( "HANDSHAKE done" );
91 2         12 $self->SUPER::configure( on_read => undef );
92              
93 2         176 $f->done( $self );
94             }
95              
96 2         172 return 0;
97 2         1546 } );
98              
99 2         160 return $f;
100             }
101              
102             =head2 connect
103              
104             $self->connect( %params )->get
105              
106             Connect to a WebSocket server. Takes the following named parameters:
107              
108             =over 8
109              
110             =item url => STRING
111              
112             URL to provide to WebSocket handshake. This is also used to infer the host and
113             service name (port number) if not otherwise supplied.
114              
115             =back
116              
117             The returned L returns the client instance itself, making it useful
118             in chaining constructors.
119              
120             =head2 connect (void)
121              
122             $self->connect( %params )
123              
124             When not returning a C, the following additional parameters provide
125             continuations:
126              
127             =over 8
128              
129             =item on_connected => CODE
130              
131             CODE reference to invoke when the handshaking is complete.
132              
133             =back
134              
135             =cut
136              
137             sub connect
138             {
139 1     1 1 220 my $self = shift;
140 1         5 my %params = @_;
141              
142 1 50       6 if( my $url = $params{url} ) {
143 1 50 33     13 $url = URI->new( $url ) unless blessed $url and $url->isa( "URI" );
144              
145 1   33     267 $params{host} //= $url->host;
146 1   33     3 $params{service} //= $url->port;
147             }
148              
149 1         3 my $on_connected = delete $params{on_connected};
150              
151             my $f = $self->SUPER::connect( %params )->then( sub {
152 1     1   343 my ( $self ) = @_;
153              
154 1         6 $self->_do_handshake( %params );
155 1         15 });
156              
157 1 50       26117 $f->on_done( $on_connected ) if $on_connected;
158              
159 1 50       25 return $f if defined wantarray;
160              
161 0         0 $self->adopt_future( $f );
162             }
163              
164             =head2 connect_handle
165              
166             $client->connect_handle( $handle, %params )->get
167              
168             Sets the read and write handles to the IO reference given, then performs the
169             initial handshake using the parameters given. These are as for C.
170              
171             =cut
172              
173             sub connect_handle
174             {
175 1     1 1 1453 my $self = shift;
176 1         4 my ( $handle, %params ) = @_;
177              
178 1         8 $self->set_handle( $handle );
179              
180 1         305 $self->_do_handshake( %params );
181             }
182              
183             =head1 AUTHOR
184              
185             Paul Evans
186              
187             =cut
188              
189             0x55AA;