view release on metacpan or  search on metacpan

lib/GDPR/IAB/TCFv2/PublisherTC.pm  view on Meta::CPAN

    return $self->_safe_is_purpose_legitimate_interest_allowed($id);
}

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

    croak
      "invalid custom purpose id $id: must be between 1 and @{[ $self->{num_custom_purposes} ]}"
      if $id < 1 || $id > $self->{num_custom_purposes};

    return $self->_safe_is_custom_purpose_consent_allowed($id);
}

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

    croak
      "invalid custom purpose id $id: must be between 1 and @{[ $self->{num_custom_purposes} ]}"
      if $id < 1 || $id > $self->{num_custom_purposes};

    return $self->_safe_is_custom_purpose_legitimate_interest_allowed($id);
}

sub TO_JSON {
    my $self = shift;

    my %consents = map { $_ => $self->_safe_is_purpose_consent_allowed($_) }
      1 .. MAX_PURPOSE_ID;
    my %legitimate_interests =
      map { $_ => $self->_safe_is_purpose_legitimate_interest_allowed($_) }
      1 .. MAX_PURPOSE_ID;
    my %custom_purpose_consents =
      map { $_ => $self->_safe_is_custom_purpose_consent_allowed($_) }
      1 .. $self->{num_custom_purposes};
    my %custom_purpose_legitimate_interests = map {
        $_ => $self->_safe_is_custom_purpose_legitimate_interest_allowed($_)
    } 1 .. $self->{num_custom_purposes};

    return {
        consents =>
          $self->_format_json_subsection( \%consents, MAX_PURPOSE_ID ),
        legitimate_interests => $self->_format_json_subsection(
            \%legitimate_interests, MAX_PURPOSE_ID
        ),
        custom_purposes => {
            consents => $self->_format_json_subsection(
                \%custom_purpose_consents, $self->{num_custom_purposes}
            ),
            legitimate_interests => $self->_format_json_subsection(
                \%custom_purpose_legitimate_interests,
                $self->{num_custom_purposes}
            ),
        },
    };
}

sub _format_json_subsection {
    my ( $self, $data, $max ) = @_;

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

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

    my $verbose = !!$self->{options}->{json}->{verbose};

    return $data if $verbose;

    return { map { $_ => $true } grep { $data->{$_} } keys %{$data} };
}

sub _safe_is_purpose_consent_allowed {
    my ( $self, $id ) = @_;
    return
      scalar(
        is_set( $self->{data}, OFFSETS->{PURPOSE_CONSENT_ALLOWED} + $id - 1 )
      );
}

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

    return
      scalar(
        is_set( $self->{data}, OFFSETS->{PURPOSE_LIT_ALLOWED} + $id - 1 ) );
}

sub _safe_is_custom_purpose_consent_allowed {
    my ( $self, $id ) = @_;
    return
      scalar(
        is_set( $self->{data}, OFFSETS->{CUSTOM_PURPOSES_CONSENT} + $id - 1 )
      );
}

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

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

1;
__END__

=head1 NAME

GDPR::IAB::TCFv2::PublisherTC - Transparency & Consent String version 2 publisher tc

=head1 SYNOPSIS

    my $publisher_tc = GDPR::IAB::TCFv2::PublisherTC->Parse(
        data         => $publisher_tc_data,
        data_size    => length($publisher_tc_data),
        options      => { json => ... },