File Coverage

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

Criterion	Covered	Total	%
statement	53	53	100.0
branch	15	22	68.1
condition			n/a
subroutine	10	10	100.0
pod	3	4	75.0
total	81	89	91.0

package GDPR::IAB::TCFv2::BitField;
use strict;
use warnings;
use integer;
use bytes;

use GDPR::IAB::TCFv2::BitUtils qw;
use Carp                       qw;

sub Parse {
    my ( $klass, %args ) = @_;

    croak "missing 'data'"      unless defined $args{data};
    croak "missing 'data_size'" unless defined $args{data_size};
    croak "missing 'max_id'"
      unless defined $args{max_id};

    croak "missing 'options'"      unless defined $args{options};
    croak "missing 'options.json'" unless defined $args{options}->{json};

    my $data      = $args{data};
    my $data_size = $args{data_size};
    my $offset    = 0;
    my $max_id    = $args{max_id};
    my $options   = $args{options};

    # add 7 to force rounding to next integer value
    my $bytes_required = ( $max_id + 7 ) / 8;

    croak
      "a BitField for $max_id requires a consent string of $bytes_required bytes. This consent string had $data_size"
      if $data_size < $bytes_required;

    my $self = {
        data    => substr( $data, $offset, $max_id ),
        max_id  => $max_id,
        options => $options,
    };

    bless $self, $klass;

    return ( $self, $offset + $max_id );
}

sub max_id {
    my $self = shift;

    return $self->{max_id};
}

sub contains {
    my ( $self, $id ) = @_;

    croak "invalid vendor id $id: must be positive integer bigger than 0"
      if $id < 1;

    return if $id > $self->{max_id};

    return is_set( $self->{data}, $id - 1 );
}

sub TO_JSON {
    my $self = shift;

    my @data = split //, $self->{data};

    if ( !!$self->{options}->{json}->{compact} ) {
        return [ grep { $data[ $_ - 1 ] } 1 .. $self->{max_id} ];
    }

    my ( $false, $true ) = @{ $self->{options}->{json}->{boolean_values} };

    if ( !!$self->{options}->{json}->{verbose} ) {
        return { map { $_ => $data[ $_ - 1 ] ? $true : $false }
              1 .. $self->{max_id} };
    }

    return {
        map  { $_ => $true }
        grep { $data[ $_ - 1 ] } 1 .. $self->{max_id}
    };
}

1;
__END__