File Coverage

blib/lib/Net/WebSocket/Base/DataFrame.pm
Criterion Covered Total %
statement 28 33 84.8
branch 5 8 62.5
condition 2 2 100.0
subroutine 7 8 87.5
pod 0 2 0.0
total 42 53 79.2


line stmt bran cond sub pod time code
1             package Net::WebSocket::Base::DataFrame;
2              
3 15     15   7527 use strict;
  15         33  
  15         430  
4 15     15   74 use warnings;
  15         33  
  15         446  
5              
6 15         100 use parent qw(
7             Net::WebSocket::Frame
8 15     15   87 );
  15         30  
9              
10             use constant {
11 15         1534 is_control => 0,
12             _MAX_32_BIT_LENGTH => 0xffffffff,
13 15     15   875 };
  15         34  
14              
15             #accessed from tests
16             our $_can_pack_Q;
17             BEGIN {
18 15     15   56 $_can_pack_Q = eval { pack 'Q', 0 };
  15         5126  
19             }
20              
21             my $length;
22              
23             sub _assemble_length {
24 77     77   155 my ($class, $payload_sr) = @_;
25              
26 77         121 my ($byte2, $len_len);
27              
28 77         162 $length = length $$payload_sr;
29              
30 77 100       178 if ($length < 126) {
    100          
31 71         145 $byte2 = chr(length $$payload_sr);
32 71         139 $len_len = q<>;
33             }
34             elsif ($length < 65536) {
35 4         9 $byte2 = "\x7e"; #126
36 4         41 $len_len = pack 'n', $length;
37             }
38             else {
39 2         5 $byte2 = "\x7f"; #127
40              
41             #Even without 64-bit support, we can still support
42             #anything up to a 32-bit length
43 2 50       9 if ($_can_pack_Q) {
    0          
44 2         11 $len_len = pack 'Q>', $length;
45             }
46             elsif ($length <= _MAX_32_BIT_LENGTH) {
47 0         0 $len_len = "\0\0\0\0" . (pack 'N', $length);
48             }
49             else {
50 0         0 die sprintf( "This Perl version (%s) doesn’t support 64-bit integers, which means WebSocket frames must be no larger than %d bytes. You tried to create a %d-byte frame.", $^V, _MAX_32_BIT_LENGTH, $length);
51             }
52             }
53              
54 77         233 return ($byte2, $len_len);
55             }
56              
57             sub set_fin {
58 0     0 0 0 my ($self) = @_;
59              
60 0         0 $self->_activate_highest_bit( $self->[$self->FIRST2], 0 );
61              
62 0         0 return $self;
63             }
64              
65             sub get_fin {
66 13     13 0 29 my ($self) = @_;
67              
68 13   100     24 return( ord ("\x80" & ${$self->[$self->FIRST2]}) && 1 );
69             }
70              
71             1;