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

package Net::WebSocket::Base::DataFrame;

use strict;
use warnings;

use parent qw(
    Net::WebSocket::Frame
);

use constant {
    is_control => 0,
    _MAX_32_BIT_LENGTH => 0xffffffff,
};

#accessed from tests
our $_can_pack_Q;
BEGIN {
    $_can_pack_Q = eval { pack 'Q', 0 };
}

my $length;

sub _assemble_length {
    my ($class, $payload_sr) = @_;

    my ($byte2, $len_len);

    $length = length $$payload_sr;

    if ($length < 126) {
        $byte2 = chr(length $$payload_sr);
        $len_len = q<>;
    }
    elsif ($length < 65536) {
        $byte2 = "\x7e";  #126
        $len_len = pack 'n', $length;
    }
    else {
        $byte2 = "\x7f"; #127

        #Even without 64-bit support, we can still support
        #anything up to a 32-bit length
        if ($_can_pack_Q) {
            $len_len = pack 'Q>', $length;
        }
        elsif ($length <= _MAX_32_BIT_LENGTH) {
            $len_len = "\0\0\0\0" . (pack 'N', $length);
        }
        else {
            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);
        }
    }

    return ($byte2, $len_len);
}

sub set_fin {
    my ($self) = @_;

    $self->_activate_highest_bit( $self->[$self->FIRST2], 0 );

    return $self;
}

sub get_fin {
    my ($self) = @_;

    return( ord ("\x80" & ${$self->[$self->FIRST2]}) && 1 );
}

1;