File Coverage

blib/lib/Net/WebSocket/Endpoint.pm
Criterion Covered Total %
statement 105 113 92.9
branch 18 26 69.2
condition 1 2 50.0
subroutine 28 29 96.5
pod 0 12 0.0
total 152 182 83.5


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 10     10   4689 use strict;
  10         23  
  10         293  
16 10     10   59 use warnings;
  10         19  
  10         233  
17              
18 10     10   606 use Module::Runtime ();
  10         1951  
  10         178  
19              
20 10     10   4326 use Net::WebSocket::Defragmenter ();
  10         26  
  10         204  
21 10     10   3724 use Net::WebSocket::Frame::close ();
  10         24  
  10         194  
22 10     10   4237 use Net::WebSocket::Frame::ping ();
  10         29  
  10         200  
23 10     10   3766 use Net::WebSocket::Frame::pong ();
  10         23  
  10         196  
24 10     10   4112 use Net::WebSocket::Message ();
  10         26  
  10         200  
25 10     10   4132 use Net::WebSocket::PingStore ();
  10         26  
  10         196  
26 10     10   58 use Net::WebSocket::X ();
  10         76  
  10         196  
27              
28 10     10   46 use constant DEFAULT_MAX_PINGS => 3;
  10         20  
  10         14048  
29              
30             sub new {
31 9     9 0 1160 my ($class, %opts) = @_;
32              
33 9         32 my @missing = grep { !length $opts{$_} } qw( out parser );
  18         124  
34              
35 9 50       44 die "Missing: [@missing]" if @missing;
36              
37 9 50       99 if ( !(ref $opts{'out'})->can('write') ) {
38 0         0 die "“out” ($opts{'out'}) needs a write() method!";
39             }
40              
41 9         43 my $self;
42              
43             my $defragger = Net::WebSocket::Defragmenter->new(
44             parser => $opts{'parser'},
45              
46             on_data_frame => $opts{'on_data_frame'},
47              
48             on_control_frame => sub {
49 6     6   56 $self->_handle_control_frame(shift);
50             },
51              
52             on_protocol_error => sub {
53 2     2   7 ( undef, my $msg ) = @_;
54              
55             #For now … there may be some multiplexing extension
56             #that allows some other behavior down the line,
57             #but let’s enforce standard protocol for now.
58 2         32 my $err_frame = Net::WebSocket::Frame::close->new(
59             code => 'PROTOCOL_ERROR',
60             reason => $msg,
61             $self->FRAME_MASK_ARGS(),
62             );
63              
64 2         24 $self->_write_frame($err_frame);
65             },
66 9         178 );
67              
68             $self = {
69             _max_pings => $class->DEFAULT_MAX_PINGS(),
70              
71             _ping_store => Net::WebSocket::PingStore->new(),
72              
73             _defragger => $defragger,
74              
75 9 100       121 (map { defined($opts{$_}) ? ( "_$_" => $opts{$_} ) : () } qw(
  27         140  
76             max_pings
77              
78             on_data_frame
79              
80             out
81             )),
82             };
83              
84 9         48 return bless $self, $class;
85             }
86              
87             sub get_next_message {
88 22     22 0 3165 my ($self) = @_;
89              
90 22         91 $self->_verify_not_closed();
91              
92 22         78 return $self->{'_defragger'}->get_next_message();
93             }
94              
95             sub create_message {
96 2     2 0 871 my ($self, $frame_type, $payload) = @_;
97              
98 2         502 require Net::WebSocket::FrameTypeName;
99              
100 2         10 my $frame_class = Net::WebSocket::FrameTypeName::get_module($frame_type);
101 2 50       26 Module::Runtime::require_module($frame_class) if !$frame_class->can('new');
102              
103 2         40 return Net::WebSocket::Message->new(
104             $frame_class->new(
105             payload => $payload,
106             $self->FRAME_MASK_ARGS(),
107             ),
108             );
109             }
110              
111             sub check_heartbeat {
112 10     10 0 1670 my ($self) = @_;
113              
114 10         43 my $ping_counter = $self->{'_ping_store'}->get_count();
115              
116 10 100       31 if ($ping_counter == $self->{'_max_pings'}) {
117 1         11 $self->close(
118             code => 'POLICY_VIOLATION',
119             reason => "Unanswered ping(s): $ping_counter",
120             );
121             }
122              
123 10         26 my $ping_message = $self->{'_ping_store'}->add();
124              
125 10         79 my $ping = Net::WebSocket::Frame::ping->new(
126             payload => $ping_message,
127             $self->FRAME_MASK_ARGS(),
128             );
129              
130 10         36 $self->_write_frame($ping);
131              
132 10         3711 return;
133             }
134              
135             sub close {
136 1     1 0 5 my ($self, %opts) = @_;
137              
138             my $close = Net::WebSocket::Frame::close->new(
139             $self->FRAME_MASK_ARGS(),
140             code => $opts{'code'} || 'ENDPOINT_UNAVAILABLE',
141 1   50     16 reason => $opts{'reason'},
142             );
143              
144 1         6 return $self->_close_with_frame($close);
145             }
146              
147             sub _close_with_frame {
148 3     3   9 my ($self, $close_frame) = @_;
149              
150 3         27 $self->_write_frame($close_frame);
151              
152 3         1384 $self->{'_sent_close_frame'} = $close_frame;
153              
154 3         12 return $self;
155             }
156              
157             *shutdown = *close;
158              
159             sub is_closed {
160 2     2 0 7430 my ($self) = @_;
161 2 100       21 return $self->{'_sent_close_frame'} ? 1 : 0;
162             }
163              
164             sub received_close_frame {
165 1     1 0 425 my ($self) = @_;
166 1         6 return $self->{'_received_close_frame'};
167             }
168              
169             sub sent_close_frame {
170 5     5 0 971 my ($self) = @_;
171 5         24 return $self->{'_sent_close_frame'};
172             }
173              
174             sub die_on_close {
175 0     0 0 0 my ($self) = @_;
176              
177 0         0 $self->{'_no_die_on_close'} = 0;
178              
179 0         0 return;
180             }
181              
182             sub do_not_die_on_close {
183 2     2 0 14 my ($self) = @_;
184              
185 2         16 $self->{'_no_die_on_close'} = 1;
186              
187 2         6 return;
188             }
189              
190             #----------------------------------------------------------------------
191              
192             sub on_ping {
193 3     3 0 8 my ($self, $frame) = @_;
194              
195 3         17 $self->_write_frame(
196             Net::WebSocket::Frame::pong->new(
197             payload => $frame->get_payload(),
198             $self->FRAME_MASK_ARGS(),
199             ),
200             );
201              
202 3         1564 return;
203             }
204              
205             sub on_pong {
206 1     1 0 3 my ($self, $frame) = @_;
207              
208 1         7 $self->{'_ping_store'}->remove( $frame->get_payload() );
209              
210 1         3 return;
211             }
212              
213             #----------------------------------------------------------------------
214              
215             sub _verify_not_closed {
216 22     22   46 my ($self) = @_;
217              
218 22 50       107 die Net::WebSocket::X->create('EndpointAlreadyClosed') if $self->{'_closed'};
219              
220 22         47 return;
221             }
222              
223             sub _handle_control_frame {
224 6     6   23 my ($self, $frame) = @_;
225              
226 6         25 my $type = $frame->get_type();
227              
228 6 100       68 if ($type eq 'close') {
    50          
229 2 50       8 if (!$self->{'_sent_close_frame'}) {
230 2         9 my ($code, $reason) = $frame->get_code_and_reason();
231              
232 2 100       10 if ($code > 4999) {
233 1         3 my $reason_chunk = substr( $reason, 0, 50 );
234 1         4 $reason = "Invalid close code ($code, reason: $reason_chunk) received.";
235 1         3 $code = 'PROTOCOL_ERROR';
236             }
237              
238             $self->_close_with_frame(
239 2         21 Net::WebSocket::Frame::close->new(
240             code => $code,
241             reason => $reason,
242             $self->FRAME_MASK_ARGS(),
243             ),
244             );
245             }
246              
247 2 50       45 if ($self->{'_received_close_frame'}) {
248 0         0 warn sprintf('Extra close frame received! (%v.02x)', $frame->to_bytes());
249             }
250             else {
251 2         35 $self->{'_received_close_frame'} = $frame;
252             }
253              
254 2 50       11 if (!$self->{'_no_die_on_close'}) {
255 0         0 die Net::WebSocket::X->create('ReceivedClose', $frame);
256             }
257             }
258             elsif ( my $handler_cr = $self->can("on_$type") ) {
259 4         16 $handler_cr->( $self, $frame );
260             }
261             else {
262 0         0 my $ref = ref $self;
263 0         0 die Net::WebSocket::X->create(
264             'ReceivedBadControlFrame',
265             "“$ref” cannot handle a control frame of type “$type”",
266             );
267             }
268              
269 6         25 return;
270             }
271              
272             sub _write_frame {
273 18     18   48 my ($self, $frame) = @_;
274              
275 18         97 return $self->{'_out'}->write($frame->to_bytes());
276             }
277              
278             1;