GDPR-IAB-TCFv2

 view release on metacpan or  search on metacpan

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


use GDPR::IAB::TCFv2::BitField;
use GDPR::IAB::TCFv2::BitUtils qw<is_set
  get_uint3
  get_uint6
  get_uint12
  get_uint16
  get_uint36
  get_char6_pair
>;
use GDPR::IAB::TCFv2::Publisher;
use GDPR::IAB::TCFv2::RangeSection;
use GDPR::IAB::TCFv2::Constants::RestrictionType qw<:all>;

use constant {
  CONSENT_STRING_TCF_V2   => {SEPARATOR => quotemeta q<.>, PREFIX => q<C>, MIN_BYTE_SIZE => 29,},
  EXPECTED_TCF_V2_VERSION => 2,
  MAX_SPECIAL_FEATURE_ID  => 12,
  MAX_PURPOSE_ID          => 24,
  DATE_FORMAT_ISO_8601    => '%Y-%m-%dT%H:%M:%SZ',
  TCF_V23_DEADLINE        => 1772236800,                                                          # 2026-02-28T00:00:00Z
  SEGMENT_TYPES           => {CORE => 0, DISCLOSED_VENDORS => 1, ALLOWED_VENDORS => 2, PUBLISHER_TC => 3,},
  OFFSETS                 => {
    SEGMENT_TYPE            => 0,
    VERSION                 => 0,
    CREATED                 => 6,
    LAST_UPDATED            => 42,
    CMP_ID                  => 78,
    CMP_VERSION             => 90,
    CONSENT_SCREEN          => 102,
    CONSENT_LANGUAGE        => 108,
    VENDOR_LIST_VERSION     => 120,
    POLICY_VERSION          => 132,
    SERVICE_SPECIFIC        => 138,
    USE_NON_STANDARD_STACKS => 139,
    SPECIAL_FEATURE_OPT_IN  => 140,
    PURPOSE_CONSENT_ALLOWED => 152,
    PURPOSE_LIT_ALLOWED     => 176,
    PURPOSE_ONE_TREATMENT   => 200,
    PUBLISHER_COUNTRY_CODE  => 201,
    VENDOR_CONSENT          => 213,
  },
};

use overload q<""> => \&tc_string;

# ABSTRACT: gdpr iab tcf v2.3 consent string parser

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

  croak 'missing gdpr consent string' unless defined $tc_string && length $tc_string;

  my $segments = _decode_tc_string_segments($tc_string);

  my $strict = !!$opts{strict};

  my %options = (json => $opts{json} // {}, strict => $strict, reference_time => $opts{reference_time},);

  $options{json}->{date_format}    ||= DATE_FORMAT_ISO_8601;
  $options{json}->{boolean_values} ||= [_json_false(), _json_true()];

  if (exists $opts{prefetch}) {
    my $prefetch = $opts{prefetch};

    $prefetch = [$prefetch] if ref($prefetch) ne ref([]);

    $options{prefetch} = $prefetch;
  }

  my $self = {
    core_data              => $segments->{core_data},
    disclosed_vendors_data => $segments->{disclosed_vendors},
    allowed_vendors_data   => $segments->{allowed_vendors},
    publisher_tc_data      => $segments->{publisher_tc},
    options                => \%options,
    tc_string              => $tc_string,

    vendor_consents             => undef,
    vendor_legitimate_interests => undef,
    publisher                   => undef,
    disclosed_vendors           => undef,
    allowed_vendors             => undef,
  };

  bless $self, $klass;

  croak "consent string is not tcf version @{[ EXPECTED_TCF_V2_VERSION ]}"
    if $strict && $self->version != EXPECTED_TCF_V2_VERSION;

  croak 'invalid vendor list version' if $self->vendor_list_version == 0;

  # TCF v2.3: Mandatory Disclosed Vendors segment check
  if ($strict && $self->is_v23) {
    croak "TCF v2.3: Disclosed Vendors segment is mandatory" unless $self->has_vendor_disclosure;
  }

  my $next_offset = $self->_parse_vendor_section();

  $self->_parse_publisher_section($next_offset);

  $self->_parse_disclosed_vendors();
  $self->_parse_allowed_vendors();

  return $self;
}

sub tc_string {
  my $self = shift;

  return $self->{tc_string};
}

sub version {
  my $self = shift;

  return scalar(get_uint6($self->{core_data}, OFFSETS->{VERSION}));
}

sub created {
  my $self = shift;

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


  if ($default_is_li) {
    return $self->is_vendor_legitimate_interest_allowed($vendor_id, $purpose_id, %opts);
  }

  return $self->is_vendor_consent_allowed($vendor_id, $purpose_id, %opts);
}

sub _check_purpose_id {
  my ($self, $id, %opts) = @_;

  my $strict = exists $opts{strict} ? $opts{strict} : $self->{options}->{strict};

  if ($id < 1 || $id > MAX_PURPOSE_ID) {
    if ($strict) {
      croak "invalid purpose id $id: must be between 1 and @{[ MAX_PURPOSE_ID ]}";
    }
    else {
      carp "invalid purpose id $id: must be between 1 and @{[ MAX_PURPOSE_ID ]}";
      return 0;
    }
  }

  return 1;
}

sub _format_date {
  my ($self, $epoch, $nanoseconds) = @_;

  return $epoch if !!$self->{options}->{json}->{use_epoch};

  my $format = $self->{options}->{json}->{date_format};

  return $format->($epoch, $nanoseconds) if ref($format) eq ref(sub { });

  return strftime($format, gmtime($epoch));
}

sub _json_true { 1 == 1 }

sub _json_false { 1 == 0 }

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

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

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

  return {map { @{$_} } grep { $verbose || $_->[1] } @data};
}

sub TO_JSON {
  my $self = shift;

  my %args      = (@_ && ref $_[-1] eq 'HASH') ? %{pop @_} : @_;
  my $filter_id = $args{vendor_id} // $self->{options}->{json}->{vendor_id};

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

  my $created      = $self->_format_date($self->created);
  my $last_updated = $self->_format_date($self->last_updated);

  my $purpose_consents = $self->_format_json_subsection(
    map { [
      $_ => (
          $filter_id
        ? $self->is_vendor_allowed_for_any_basis($filter_id, $_)
        : $self->_safe_is_purpose_consent_allowed($_)
      ) ? $true : $false
    ] } 1 .. MAX_PURPOSE_ID,
  );

  my $purpose_li = $self->_format_json_subsection(
    map { [
      $_ => (
          $filter_id
        ? $self->is_vendor_legitimate_interest_allowed($filter_id, $_)
        : $self->_safe_is_purpose_legitimate_interest_allowed($_)
      ) ? $true : $false
    ] } 1 .. MAX_PURPOSE_ID,
  );

  return {
    tc_string               => $self->tc_string,
    version                 => $self->version,
    created                 => $created,
    last_updated            => $last_updated,
    cmp_id                  => $self->cmp_id,
    cmp_version             => $self->cmp_version,
    consent_screen          => $self->consent_screen,
    consent_language        => $self->consent_language,
    vendor_list_version     => $self->vendor_list_version,
    policy_version          => $self->policy_version,
    is_service_specific     => $self->is_service_specific     ? $true : $false,
    use_non_standard_stacks => $self->use_non_standard_stacks ? $true : $false,
    purpose_one_treatment   => $self->purpose_one_treatment   ? $true : $false,
    publisher_country_code  => $self->publisher_country_code,
    special_features_opt_in => $self->_format_json_subsection(
      map { [$_ => $self->_safe_is_special_feature_opt_in($_) ? $true : $false] } 1 .. MAX_SPECIAL_FEATURE_ID
    ),
    purpose => {consents => $purpose_consents, legitimate_interests => $purpose_li,},
    vendor  => {
      consents             => $self->{vendor_consents}->TO_JSON($filter_id),
      legitimate_interests => $self->{vendor_legitimate_interests}->TO_JSON($filter_id),
      ($self->{disclosed_vendors} ? (disclosed => $self->{disclosed_vendors}->TO_JSON($filter_id)) : ()),
      ($self->{allowed_vendors}   ? (allowed   => $self->{allowed_vendors}->TO_JSON($filter_id))   : ()),
    },
    publisher => $self->{publisher}->TO_JSON($filter_id),
  };
}

sub _decode_tc_string_segments {
  my $tc_string = shift;

  my ($core, @parts) = split CONSENT_STRING_TCF_V2->{SEPARATOR}, $tc_string;

  my $core_data      = _validate_and_decode_base64($core);
  my $core_data_size = length($core_data);

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

use the L<GDPR::IAB::TCFv2::Validator> companion class instead of stringing
the predicates above together by hand:

    use GDPR::IAB::TCFv2::Validator;

    my $validator = GDPR::IAB::TCFv2::Validator->new(
        vendor_id                       => 284,
        consent_purpose_ids             => [ 1, 3 ],
        legitimate_interest_purpose_ids => [ 7 ],
    );

    my $tc_string = '...';
    my $result = $validator->validate($tc_string);   # fail-fast
    # ...or $validator->validate_all($tc_string) to accumulate every reason

    if ($result) {
        # vendor 284 has every required permission
    }
    else {
        warn "compliance failed: $result\n";   # stringifies to the reasons
        warn $_ for $result->reasons;
    }

=head1 DESCRIPTION

C<GDPR::IAB::TCFv2::Parser> is the single-pass bit-stream decoder for
TCF v2.3 (and v2.0/v2.2) consent strings, as specified by the IAB. It
is normally constructed via the L<GDPR::IAB::TCFv2> hub
(C<< GDPR::IAB::TCFv2->Parse(...) >>) but can be called directly when
you want to bypass the hub's facade.

The returned object exposes every accessor, predicate, and JSON
serializer documented below.

=head1 CONSTRUCTOR

=head2 Parse

The Parse method will decode and validate a base64 encoded version of the tcf v2 string.

Will return a C<GDPR::IAB::TCFv2::Parser> immutable object that allow easy access to different properties.

Will die if can't decode the string.

    use GDPR::IAB::TCFv2::Parser;

    my $consent = GDPR::IAB::TCFv2::Parser->Parse(
        'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'
    );

or

    use GDPR::IAB::TCFv2::Parser;

    my $consent = GDPR::IAB::TCFv2::Parser->Parse(
        'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA',
        json => {
            verbose        => 0,
            compact        => 1,
            use_epoch      => 0,
            boolean_values => [ 0, 1 ],
            date_format    => '%Y%m%d',    # yyymmdd
        },
        strict => 1,
        prefetch => 284,
    );

Parse may receive an optional hash with the following parameters:

=over

=item *

On C<strict> mode we will validate if the version of the consent string is the version 2 (or die with an exception).

Additionally, for TCF v2.3 strings (Policy Version 5+), C<strict> mode will enforce that the B<Disclosed Vendors> segment is present.

The C<strict> mode is disabled by default.

=item *

The C<prefetch> option receives one (as scalar) or more (as arrayref) vendor ids.

This is useful when parsing a range based consent string, since we need to visit all ranges to find a particular id.

=item *

C<json> is hashref with the following properties used to customize the json format:

=over

=item *

C<verbose> changes the json encoding. By default we omit some false values such as C<vendor_consents> to create
a compact json representation. With C<verbose> we will present everything. See L</TO_JSON> for more details.

=item *

C<compact> changes the json encoding. All fields that are a mapping of something to a boolean will be changed to an array
of all elements keys where the value is true. This affects the following fields:  C<special_features_opt_in>,
C<purpose/consents>, C<purpose/legitimate_interests>, C<vendor/consents> and C<vendor/legitimate_interests>. See L</TO_JSON> for more details.

=item *

C<use_epoch> changes the json encode. By default we format the C<created> and C<last_updated> are converted to string using
L<ISO_8601|https://en.wikipedia.org/wiki/ISO_8601>. With C<use_epoch> we will return the unix epoch in seconds.
See L</TO_JSON> for more details.

=item *

C<boolean_values> if present, expects an arrayref if two elements: the C<false> and the C<true> values to be used in json encoding.
If omit, we will try to use C<JSON::false> and C<JSON::true> if the package L<JSON> is available, else we will fallback to C<0> and C<1>.

=item *

C<date_format> if present accepts two kinds of value: an C<string> (to be used on C<POSIX::strftime>) or a code reference to a subroutine that
will be called with two arguments: epoch in seconds and nanoseconds. If omitted the format L<ISO_8601|https://en.wikipedia.org/wiki/ISO_8601> will be used
except if the option C<use_epoch> is true.

=item *

C<vendor_id> if present, filters the JSON output to only include data for the specific vendor ID. This affects the C<vendor> and C<publisher/restrictions> sections, drastically reducing the size of the output.

=back

=back

=head1 METHODS

=head2 tc_string

Returns the original consent string.

The consent object L<GDPR::IAB::TCFv2::Parser> will call this method on string interpolations.

=head2 version

Version number of the encoding format. The value is 2 for this format.

=head2 created

Epoch time format when TC String was created in numeric format. You can easily parse with L<DateTime> if needed.

On scalar context it returns epoch in seconds. On list context it returns epoch in seconds and nanoseconds.

    use GDPR::IAB::TCFv2::Parser;
    use Test::More tests => 3;

    my $consent = GDPR::IAB::TCFv2::Parser->Parse(
        'CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA.argAC0gAAAAAAAAAAAA'
    );

    is $consent->created, 1228644257,
      'should return the creation epoch 07/12/2008';

    my ( $seconds, $nanoseconds ) = $consent->created;
    is $seconds, 1228644257,
        'should return the creation epoch 07/12/2008 on list context';
    is $nanoseconds, 700000000,
        'should return the 700000000 nanoseconds of epoch on list context';

=head2 last_updated

Epoch time format when TC String was last updated in numeric format. You can easily parse with L<DateTime> if needed.

On scalar context it returns epoch in seconds. On list context it returns epoch in seconds and nanoseconds, like the C<created>

=head2 cmp_id

Consent Management Platform ID that last updated the TC String. Is a unique ID will be assigned to each Consent Management Platform.



( run in 0.609 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )