File Coverage

blib/lib/GDPR/IAB/TCFv2/BitUtils.pm

Criterion	Covered	Total	%
statement	76	82	92.6
branch	14	26	53.8
condition			n/a
subroutine	21	21	100.0
pod	7	8	87.5
total	118	137	86.1

package GDPR::IAB::TCFv2::BitUtils;
use strict;
use warnings;
use integer;
use bytes;
use Math::BigInt;

use Carp qw(croak confess);

require Exporter;
use base qw;

use constant ASCII_OFFSET => ord('A');

my $CAN_PACK_QUADS;
my $CAN_FORCE_BIG_ENDIAN;

BEGIN {
    $CAN_PACK_QUADS       = !!eval { my $f = pack 'Q>'; 1 };
    $CAN_FORCE_BIG_ENDIAN = !!eval { my $f = pack 'S>'; 1 };
}

our @EXPORT_OK = qw
  get_uint2
  get_uint3
  get_uint6
  get_uint12
  get_uint16
  get_uint36
  get_char6_pair
>;

sub is_set {
    my ( $data, $offset ) = @_;

    my $data_size = length($data);

    croak
      "index out of bounds on offset $offset: can't read 1, only has: $data_size"
      if $offset + 1 > $data_size;

    my $r = substr( $data, $offset, 1 ) == 1;

    return wantarray ? ( $r, $offset + 1 ) : $r;
}

sub get_uint2 {
    my ( $data, $offset ) = @_;

    return _get_big_endian_octet_8bits( $data, $offset, 2 );
}

sub get_uint3 {
    my ( $data, $offset ) = @_;

    return _get_big_endian_octet_8bits( $data, $offset, 3 );
}

sub get_uint6 {
    my ( $data, $offset ) = @_;

    return _get_big_endian_octet_8bits( $data, $offset, 6 );
}

sub get_char6_pair {
    my ( $data, $offset ) = @_;

    my $pair;

    for ( 1 .. 2 ) {
        my ( $byte, $next_offset ) = get_uint6( $data, $offset );

        $pair .= chr( ASCII_OFFSET + $byte );

        $offset = $next_offset;
    }

    return wantarray ? ( $pair, $offset ) : $pair;
}

sub get_uint12 {
    my ( $data, $offset ) = @_;

    return _get_big_endian_short_16bits( $data, $offset, 12 );
}

sub get_uint16 {
    my ( $data, $offset ) = @_;

    return _get_big_endian_short_16bits( $data, $offset, 16 );
}

sub _get_big_endian_octet_8bits {
    my ( $data, $offset, $nbits ) = @_;

    my ( $bits_with_pading, $next_offset ) =
      _get_bits_with_padding( $data, 8, $offset, $nbits );

    my $r = unpack(
        "C",
        $bits_with_pading
    );

    return wantarray ? ( $r, $next_offset ) : $r;
}

sub _get_big_endian_short_16bits {
    my ( $data, $offset, $nbits ) = @_;

    if ($CAN_FORCE_BIG_ENDIAN) {
        my ( $bits_with_pading, $next_offset ) =
          _get_bits_with_padding( $data, 16, $offset, $nbits );

        my $r = unpack( "S>", $bits_with_pading );

        return wantarray ? ( $r, $next_offset ) : $r;
    }

    my ( $data_with_padding, $next_offset ) =
      _add_padding( $data, 16, $offset, $nbits );

    my $r = Math::BigInt->new( "0b" . $data_with_padding );

    return wantarray ? ( $r, $next_offset ) : $r;
}

sub get_uint36 {
    my ( $data, $offset ) = @_;

    if ($CAN_PACK_QUADS) {
        my ( $bits_with_pading, $next_offset ) =
          _get_bits_with_padding( $data, 64, $offset, 36 );

        my $r = unpack( "Q>", $bits_with_pading );

        return wantarray ? ( $r, $next_offset ) : $r;
    }

    my ( $data_with_padding, $next_offset ) =
      _add_padding( $data, 64, $offset, 36 );

    my $r = Math::BigInt->new( "0b" . $data_with_padding );

    return wantarray ? ( $r, $next_offset ) : $r;
}

sub _get_bits_with_padding {
    my ( $data, $bits, $offset, $nbits ) = @_;

    my ( $data_with_padding, $next_offset ) =
      _add_padding( $data, $bits, $offset, $nbits );

    my $r = pack( "B${bits}", $data_with_padding );

    return wantarray ? ( $r, $next_offset ) : $r;
}

sub _add_padding {
    my ( $data, $bits, $offset, $nbits ) = @_;

    my $data_size = length($data);

    croak
      "index out of bounds on offset $offset: can't read $nbits, only has: $data_size"
      if $offset + $nbits > $data_size;

    my $padding = "0" x ( $bits - $nbits );

    my $r = $padding . substr( $data, $offset, $nbits );

    return wantarray ? ( $r, $offset + $nbits ) : $r;
}

1;
__END__