File Coverage

blib/lib/Net/WebSocket/Endpoint.pm
Criterion Covered Total %
statement 68 121 56.2
branch 18 38 47.3
condition 0 2 0.0
subroutine 16 27 59.2
pod 0 11 0.0
total 102 199 51.2


line stmt bran cond sub pod time code
1             package Net::WebSocket::Endpoint;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Net::WebSocket::Endpoint
8              
9             =head1 DESCRIPTION
10              
11             See L.
12              
13             =cut
14              
15 1     1   260 use strict;
  1         2  
  1         23  
16 1     1   3 use warnings;
  1         2  
  1         17  
17              
18 1     1   208 use Call::Context ();
  1         284  
  1         25  
19              
20 1     1   357 use Net::WebSocket::Frame::close ();
  1         2  
  1         16  
21 1     1   226 use Net::WebSocket::Frame::ping ();
  1         2  
  1         14  
22 1     1   229 use Net::WebSocket::Frame::pong ();
  1         3  
  1         25  
23 1     1   323 use Net::WebSocket::Message ();
  1         2  
  1         15  
24 1     1   226 use Net::WebSocket::PingStore ();
  1         2  
  1         17  
25 1     1   5 use Net::WebSocket::X ();
  1         1  
  1         14  
26              
27 1     1   4 use constant DEFAULT_MAX_PINGS => 3;
  1         2  
  1         988  
28              
29             sub new {
30 1     1 0 10 my ($class, %opts) = @_;
31              
32 1         3 my @missing = grep { !length $opts{$_} } qw( out parser );
  2         9  
33              
34 1 50       4 die "Missing: [@missing]" if @missing;
35              
36 1 50       6 if ( !(ref $opts{'out'})->can('write') ) {
37 0         0 die "“out” ($opts{'out'}) needs a write() method!";
38             }
39              
40             my $self = {
41             _fragments => [],
42              
43             _max_pings => $class->DEFAULT_MAX_PINGS(),
44              
45             _ping_store => Net::WebSocket::PingStore->new(),
46              
47 1 100       8 (map { defined($opts{$_}) ? ( "_$_" => $opts{$_} ) : () } qw(
  4         13  
48             parser
49             max_pings
50              
51             on_data_frame
52              
53             out
54             )),
55             };
56              
57 1         4 return bless $self, $class;
58             }
59              
60             sub get_next_message {
61 9     9 0 1294 my ($self) = @_;
62              
63 9         26 $self->_verify_not_closed();
64              
65 9         12 my $_msg_frame;
66              
67 9 50       27 if ( $_msg_frame = $self->{'_parser'}->get_next_frame() ) {
68 9 100       42 if ($_msg_frame->is_control_frame()) {
69 2         7 $self->_handle_control_frame($_msg_frame);
70             }
71             else {
72 7 50       18 if ($self->{'_on_data_frame'}) {
73 0         0 $self->{'_on_data_frame'}->($_msg_frame);
74             }
75              
76             #Failure cases:
77             # - continuation without prior fragment
78             # - non-continuation within fragment
79              
80 7 100       24 if ( $_msg_frame->get_type() eq 'continuation' ) {
    50          
81 2 50       3 if ( !@{ $self->{'_fragments'} } ) {
  2         6  
82 0         0 $self->_got_continuation_during_non_fragment($_msg_frame);
83             }
84             }
85 5         14 elsif ( @{ $self->{'_fragments'} } ) {
86 0         0 $self->_got_non_continuation_during_fragment($_msg_frame);
87             }
88              
89 7 100       24 if ($_msg_frame->get_fin()) {
90             return Net::WebSocket::Message::create_from_frames(
91 5         10 splice( @{ $self->{'_fragments'} } ),
  5         16  
92             $_msg_frame,
93             );
94             }
95             else {
96 2         37 push @{ $self->{'_fragments'} }, $_msg_frame;
  2         7  
97             }
98             }
99             }
100              
101 4 50       20 return defined($_msg_frame) ? q<> : undef;
102             }
103              
104             sub check_heartbeat {
105 0     0 0 0 my ($self) = @_;
106              
107 0         0 my $ping_counter = $self->{'_ping_store'}->get_count();
108              
109 0 0       0 if ($ping_counter == $self->{'_max_pings'}) {
110 0         0 $self->close(
111             code => 'POLICY_VIOLATION',
112             reason => "Unanswered ping(s): $ping_counter",
113             );
114             }
115              
116 0         0 my $ping_message = $self->{'_ping_store'}->add();
117              
118 0         0 my $ping = Net::WebSocket::Frame::ping->new(
119             payload_sr => \$ping_message,
120             $self->FRAME_MASK_ARGS(),
121             );
122              
123 0         0 $self->_write_frame($ping);
124              
125 0         0 return;
126             }
127              
128             sub close {
129 0     0 0 0 my ($self, %opts) = @_;
130              
131             my $close = Net::WebSocket::Frame::close->new(
132             $self->FRAME_MASK_ARGS(),
133             code => $opts{'code'} || 'ENDPOINT_UNAVAILABLE',
134 0   0     0 reason => $opts{'reason'},
135             );
136              
137 0         0 return $self->_close_with_frame($close);
138             }
139              
140             sub _close_with_frame {
141 0     0   0 my ($self, $close_frame) = @_;
142              
143 0         0 $self->_write_frame($close_frame);
144              
145 0         0 $self->{'_sent_close_frame'} = $close_frame;
146              
147 0         0 return $self;
148             }
149              
150             *shutdown = *close;
151              
152             sub is_closed {
153 0     0 0 0 my ($self) = @_;
154 0 0       0 return $self->{'_sent_close_frame'} ? 1 : 0;
155             }
156              
157             sub received_close_frame {
158 0     0 0 0 my ($self) = @_;
159 0         0 return $self->{'_received_close_frame'};
160             }
161              
162             sub sent_close_frame {
163 0     0 0 0 my ($self) = @_;
164 0         0 return $self->{'_sent_close_frame'};
165             }
166              
167             sub die_on_close {
168 0     0 0 0 my ($self) = @_;
169              
170 0         0 $self->{'_no_die_on_close'} = 0;
171              
172 0         0 return;
173             }
174              
175             sub do_not_die_on_close {
176 0     0 0 0 my ($self) = @_;
177              
178 0         0 $self->{'_no_die_on_close'} = 1;
179              
180 0         0 return;
181             }
182              
183             #----------------------------------------------------------------------
184              
185             sub on_ping {
186 2     2 0 3 my ($self, $frame) = @_;
187              
188 2         16 $self->_write_frame(
189             Net::WebSocket::Frame::pong->new(
190             payload_sr => \$frame->get_payload(),
191             $self->FRAME_MASK_ARGS(),
192             ),
193             );
194              
195 2         81 return;
196             }
197              
198             sub on_pong {
199 0     0 0 0 my ($self, $frame) = @_;
200              
201 0         0 $self->{'_ping_store'}->remove( $frame->get_payload() );
202              
203 0         0 return;
204             }
205              
206             #----------------------------------------------------------------------
207              
208             sub _got_continuation_during_non_fragment {
209 0     0   0 my ($self, $frame) = @_;
210              
211 0         0 my $msg = sprintf('Received continuation outside of fragment!');
212              
213             #For now … there may be some multiplexing extension
214             #that allows some other behavior down the line,
215             #but let’s enforce standard protocol for now.
216 0         0 my $err_frame = Net::WebSocket::Frame::close->new(
217             code => 'PROTOCOL_ERROR',
218             reason => $msg,
219             $self->FRAME_MASK_ARGS(),
220             );
221              
222 0         0 $self->_write_frame($err_frame);
223              
224 0         0 die Net::WebSocket::X->create( 'ReceivedBadControlFrame', $msg );
225             }
226              
227             sub _got_non_continuation_during_fragment {
228 0     0   0 my ($self, $frame) = @_;
229              
230 0         0 my $msg = sprintf('Received %s; expected continuation!', $frame->get_type());
231              
232             #For now … there may be some multiplexing extension
233             #that allows some other behavior down the line,
234             #but let’s enforce standard protocol for now.
235 0         0 my $err_frame = Net::WebSocket::Frame::close->new(
236             code => 'PROTOCOL_ERROR',
237             reason => $msg,
238             $self->FRAME_MASK_ARGS(),
239             );
240              
241 0         0 $self->_write_frame($err_frame);
242              
243 0         0 die Net::WebSocket::X->create( 'ReceivedBadControlFrame', $msg );
244             }
245              
246             sub _verify_not_closed {
247 9     9   12 my ($self) = @_;
248              
249 9 50       24 die Net::WebSocket::X->create('EndpointAlreadyClosed') if $self->{'_closed'};
250              
251 9         13 return;
252             }
253              
254             sub _handle_control_frame {
255 2     2   3 my ($self, $frame) = @_;
256              
257 2         7 my $type = $frame->get_type();
258              
259 2 50       14 if ($type eq 'close') {
    50          
260 0 0       0 if (!$self->{'_sent_close_frame'}) {
261 0         0 $self->_close_with_frame($frame);
262             }
263              
264 0 0       0 if ($self->{'_received_close_frame'}) {
265 0         0 warn sprintf('Extra close frame received! (%v.02x)', $frame->to_bytes());
266             }
267             else {
268 0         0 $self->{'_received_close_frame'} = $frame;
269             }
270              
271 0 0       0 if (!$self->{'_no_die_on_close'}) {
272 0         0 die Net::WebSocket::X->create('ReceivedClose', $frame);
273             }
274             }
275             elsif ( my $handler_cr = $self->can("on_$type") ) {
276 2         6 $handler_cr->( $self, $frame );
277             }
278             else {
279 0         0 my $ref = ref $self;
280 0         0 die Net::WebSocket::X->create(
281             'ReceivedBadControlFrame',
282             "“$ref” cannot handle a control frame of type “$type”",
283             );
284             }
285              
286 2         3 return;
287             }
288              
289             sub _write_frame {
290 2     2   3 my ($self, $frame) = @_;
291              
292 2         7 return $self->{'_out'}->write($frame->to_bytes());
293             }
294              
295             1;