add more methods

MANIFEST.SKIP

@@ -54,7 +54,7 @@
 \bcovered\b
 
 # Avoid MYMETA files
-^MYMETA\.
+# ^MYMETA\.
 #!end included /usr/share/perl/5.8/ExtUtils/MANIFEST.SKIP
 
 # Avoid configuration metadata file
@@ -71,3 +71,8 @@
 
 # Avoid .github actions
 \B\.github\b
+
+# Avoid other files
+\b.perlcriticrc\b
+\b.perltidyrc\b
+\b.proverc\b

lib/GDPR/IAB/TCFv2.pm

@@ -103,7 +103,34 @@ sub consent_language {
 sub vendor_list_version {
     my $self = shift;
 
-    $self->_get_uint16( 120, 12 );
+    return $self->_get_uint16( 120, 12 );
+}
+
+sub policy_version {
+    my $self = shift;
+
+    return $self->_get_uint8( 132, 6 );
+}
+
+sub is_service_specific {
+    my $self = shift;
+
+    return $self->_is_set(138);
+}
+
+sub use_non_standard_stacks {
+    my $self = shift;
+
+    return $self->_is_set(139);
+}
+
+sub is_special_feature_opt_in {
+    my ( $self, $id ) = @_;
+
+    croak "invalid special feature id $id: must be between 1 and 12"
+      if $id < 1 || $id > 12;
+
+    return $self->_is_set( 140 + $id - 1 );
 }
 
 sub is_purpose_consent_allowed {
@@ -115,6 +142,42 @@ sub is_purpose_consent_allowed {
     return $self->_is_set( 152 + $id - 1 );
 }
 
+sub is_purpose_legitimate_interest_allowed {
+    my ( $self, $id ) = @_;
+
+    croak "invalid purpose id $id: must be between 1 and 24"
+      if $id < 1 || $id > 24;
+
+    return $self->_is_set( 176 + $id - 1 );
+}
+
+sub purpose_one_treatment {
+    my $self = shift;
+
+    return $self->_is_set(200);
+}
+
+sub publisher_country_code {
+    my $self = shift;
+
+    return join "", map { chr( $_ + 65 ) } (
+        $self->_get_uint8( 201, 6 ),
+        $self->_get_uint8( 207, 6 ),
+    );
+}
+
+sub max_vendor_id {
+    my $self = shift;
+
+    return $self->_get_uint16( 213, 16 );
+}
+
+sub is_range_encoding {
+    my $self = shift;
+
+    return $self->_is_set(229);
+}
+
 sub _is_set {
     my ( $self, $offset ) = @_;
 
@@ -124,36 +187,39 @@ sub _is_set {
 sub _get_uint8 {
     my ( $self, $offset, $nbits ) = @_;
 
-    my $padding = "0" x ( 8 - $nbits );
-
     return unpack(
         "C",
-        pack( "B8", $padding . substr( $self->{data}, $offset, $nbits ) )
+        $self->_get_bits_with_padding( 8, $offset, $nbits )
     );
 }
 
 sub _get_uint16 {
     my ( $self, $offset, $nbits ) = @_;
 
-    my $padding = "0" x ( 16 - $nbits );
-
     return unpack(
         "S>",
-        pack( "B16", $padding . substr( $self->{data}, $offset, $nbits ) )
+        $self->_get_bits_with_padding( 16, $offset, $nbits )
     );
 }
 
 sub _get_uint64 {
     my ( $self, $offset, $nbits ) = @_;
 
-    my $padding = "0" x ( 64 - $nbits );
-
     return unpack(
         "Q>",
-        pack( "B64", $padding . substr( $self->{data}, $offset, $nbits ) )
+        $self->_get_bits_with_padding( 64, $offset, $nbits )
     );
 }
 
+sub _get_bits_with_padding {
+    my ( $self, $bits, $offset, $nbits ) = @_;
+
+    my $padding = "0" x ( $bits - $nbits );
+
+    return
+      pack( "B${bits}", $padding . substr( $self->{data}, $offset, $nbits ) );
+}
+
 sub looksLikeIsConsentVersion2 {
     my ($gdpr_consent_string) = @_;
 

t/01-parse.t

@@ -4,7 +4,7 @@ use Test::Exception;
 use GDPR::IAB::TCFv2;
 
 subtest "valid tcf v2 consent string" => sub {
-    plan tests => 11;
+    plan tests => 20;
 
     my $consent;
 
@@ -37,20 +37,60 @@ subtest "valid tcf v2 consent string" => sub {
     is $consent->vendor_list_version, 23,
       'should return the vendor list version 23';
 
+    is $consent->policy_version, 2,
+      'should return the policy version 2';
+
+    ok $consent->is_service_specific,
+      'should return true for service specific';
+
+    ok !$consent->use_non_standard_stacks,
+      'should return false for use non standard stacks';
+
+    ok !$consent->purpose_one_treatment,
+      'should return false for use purpose one treatment';
+
+    is $consent->publisher_country_code, "KM",
+      'should return the publisher country code "KM"';
+
+    is $consent->max_vendor_id, 115, "max vendor id is 115";
+
+    ok !$consent->is_range_encoding, "is not range encoding";
+
     subtest "check purpose consent ids" => sub {
         plan tests => 24;
 
-        my %allowed_purposes = (
-            1  => 1,
-            3  => 1,
-            9  => 1,
-            10 => 1,
-        );
+        my %allowed_purposes = map { $_ => 1 } ( 1, 3, 9, 10 );
 
         foreach my $id ( 1 .. 24 ) {
             is !!$consent->is_purpose_consent_allowed($id),
               !!$allowed_purposes{$id},
-              "checking purpose id $id";
+              "checking purpose id $id for consent";
+        }
+    };
+
+    subtest "check purpose legitimate interest ids" => sub {
+        plan tests => 24;
+
+        my %allowed_purposes = map { $_ => 1 } ( 3, 4, 5, 8, 9, 10 );
+
+        foreach my $id ( 1 .. 24 ) {
+            is !!$consent->is_purpose_legitimate_interest_allowed($id),
+              !!$allowed_purposes{$id},
+              "checking purpose id $id for legitimate interest";
+        }
+    };
+
+    subtest "check special feature opt in" => sub {
+        plan tests => 12;
+
+        my %special_feature_opt_in = (
+            2 => 1,
+        );
+
+        foreach my $id ( 1 .. 12 ) {
+            is !!$consent->is_special_feature_opt_in($id),
+              !!$special_feature_opt_in{$id},
+              "checking special feature id $id opt in";
         }
     };
 };