view release on metacpan or  search on metacpan

bin/iabtcfv2  view on Meta::CPAN

      ['-w', '--enable-warnings',              '',              'Emit human-readable warnings on STDERR'],
      ['-q', '--quiet',                        '',              'Suppress STDOUT (exit code only)'],
    ],
  },
);

my %global_opts;
GetOptions(
  'help'      => \$global_opts{full_help},
  'h'         => \$global_opts{short_help},
  'man'       => \$global_opts{man},
  'version|V' => \$global_opts{version},
) or pod2usage(-input => $script_path, -exitval => 2, -verbose => 0);

if ($global_opts{version}) {
  print "iabtcfv2 version $GDPR::IAB::TCFv2::VERSION\n";
  exit EXIT_SUCCESS;
}

if ($global_opts{short_help}) {
  _show_short_help($ARGV[0]);
}
if ($global_opts{full_help}) {
  _show_help($ARGV[0]);
}
pod2usage(-input => $script_path, -exitval => 1, -verbose => 2) if $global_opts{man};

my $subcommand = shift @ARGV;

# Bare invocation: brief overview, exit 1 (mirrors `--help` behavior).
_show_short_help() unless defined $subcommand;

# `iabtcfv2 help [<sub>]` keeps showing the full POD, same as before.
if ($subcommand eq 'help') {
  _show_help(shift @ARGV);
}

my $entry = $SUBCOMMANDS{$subcommand};
_unknown_subcommand($subcommand) unless $entry;
$entry->{runner}->(@ARGV);

sub run_dump {
  my @args = @_;
  my %opts = (
    pretty               => 0,
    compact              => 0,
    'ignore-errors'      => 0,
    'fail-fast'          => 0,
    'errors-to-stderr'   => 0,
    'quiet'              => 0,
    'enable-warnings'    => 0,
    'vendor-id'          => undef,
    'strict-legal-basis' => 0,
  );

  require Getopt::Long;
  my $parser = Getopt::Long::Parser->new(config => [qw(no_pass_through require_order bundling)]);

  my $getopt_ok;
  {
    local @ARGV = @args;
    $getopt_ok = $parser->getoptions(
      'pretty|p'             => \$opts{pretty},
      'compact|c'            => \$opts{compact},
      'ignore-errors|i'      => \$opts{'ignore-errors'},
      'fail-fast|f'          => \$opts{'fail-fast'},
      'errors-to-stderr|e'   => \$opts{'errors-to-stderr'},
      'quiet|q'              => \$opts{'quiet'},
      'enable-warnings|w'    => \$opts{'enable-warnings'},
      'vendor-id|v=i'        => \$opts{'vendor-id'},
      'strict-legal-basis|s' => \$opts{'strict-legal-basis'},
      'help'                 => sub {
        pod2usage(-input => $script_path, -exitval => 1, -verbose => 99, -sections => "DUMP|BUGS");
      },
      'h' => sub { _show_subcommand_short_help('dump'); exit 1; },
    );
    @args = @ARGV;
  }
  $getopt_ok or pod2usage(-input => $script_path, -exitval => 2, -verbose => 99, -sections => "DUMP/Usage");

  my $json_pkg = JSON->can('new') ? 'JSON' : 'JSON::PP';
  my $json     = $json_pkg->new->utf8;
  if ($opts{pretty}) {
    $json->pretty(1);
    $json->indent_length(4) if $json->isa('JSON::PP');
  }

  my $state = {count => 0, line_num => 0,};

  if (@args) {
    foreach my $str (@args) {
      $state->{line_num}++;
      _process_string($str, $state, \%opts, $json);
    }
  }
  else {
    binmode(STDIN, ':encoding(UTF-8)') if -t STDIN;    ## no critic (InputOutput::ProhibitInteractiveTest, InputOutput::RequireEncodingWithUTF8Layer)
    while (my $line = <STDIN>) {                       ## no critic (InputOutput::ProhibitExplicitStdin)
      $state->{line_num}++;
      chomp $line;
      next unless $line =~ /\S/;
      _process_string($line, $state, \%opts, $json);
    }
  }

  exit EXIT_SUCCESS;
}

sub _process_string {
  my ($str, $state, $o, $j) = @_;
  my $output_data;

  eval {
    my $tcf = GDPR::IAB::TCFv2->Parse(
      $str,
      json   => {compact => $o->{compact}, vendor_id => $o->{'vendor-id'},},
      strict => $o->{'strict-legal-basis'},
    );
    $output_data = $tcf->TO_JSON;
  };
  if (my $err = $@) {

bin/iabtcfv2  view on Meta::CPAN

    $left_width = length($left_col) if length($left_col) > $left_width;
    push @lines, [$left_col, $desc];
  }

  for my $r (@lines) {
    printf {*STDERR} "%-${left_width}s  %s\n", $r->[0], $r->[1];
  }

  print {*STDERR} "\nReads TC strings from positional args, or one per line from STDIN.\n";
  print {*STDERR} "\nRun 'iabtcfv2 $name --help' for the full documentation.\n";
}

sub _unknown_subcommand {
  my $name = shift;

  print {*STDERR} "iabtcfv2: unknown subcommand '$name'\n\n";
  print {*STDERR} "Available subcommands:\n";
  for my $sc (sort keys %SUBCOMMANDS) {
    printf {*STDERR} "    %-10s %s\n", $sc, $SUBCOMMANDS{$sc}{summary};
  }
  print {*STDERR} "\n";
  print {*STDERR} "Run 'iabtcfv2 -h' for a short overview, or 'iabtcfv2 --help' for the full manual.\n";
  exit 2;
}

sub _parse_id_list {
  my $s = shift;
  return [] unless defined $s && length $s;
  return [map { 0 + $_ } grep { length $_ } split /\s*,\s*/, $s];
}

sub run_validate {    ## no critic (Subroutines::ProhibitExcessComplexity)
  my @args = @_;
  my %opts = (
    pretty                         => 0,
    'ignore-errors'                => 0,
    'fail-fast'                    => 0,
    'errors-to-stderr'             => 0,
    quiet                          => 0,
    'enable-warnings'              => 0,
    'vendor-id'                    => undef,
    'consent-purposes'             => undef,
    'legitimate-interest-purposes' => undef,
    'flexible-purposes'            => undef,
    'verify-disclosed-vendors'     => 0,
    'strict-legal-basis'           => 0,
    'min-tcf-policy-version'       => undef,
    'cmp-validator'                => undef,
    'cmp-validator-network-ok'     => 0,
    'cmp-validator-verify-ssl'     => 1,
    'cmp-validator-timeout'        => 30,
    all                            => 0,
    text                           => 0,
  );

  require Getopt::Long;
  my $parser = Getopt::Long::Parser->new(config => [qw(no_pass_through require_order bundling)]);

  my $getopt_ok;
  {
    local @ARGV = @args;
    $getopt_ok = $parser->getoptions(
      'pretty|p'                         => \$opts{pretty},
      'ignore-errors|i'                  => \$opts{'ignore-errors'},
      'fail-fast|f'                      => \$opts{'fail-fast'},
      'errors-to-stderr|e'               => \$opts{'errors-to-stderr'},
      'quiet|q'                          => \$opts{quiet},
      'enable-warnings|w'                => \$opts{'enable-warnings'},
      'vendor-id|v=i'                    => \$opts{'vendor-id'},
      'consent-purposes|C=s'             => \$opts{'consent-purposes'},
      'legitimate-interest-purposes|L=s' => \$opts{'legitimate-interest-purposes'},
      'flexible-purposes|F=s'            => \$opts{'flexible-purposes'},
      'verify-disclosed-vendors|d'       => \$opts{'verify-disclosed-vendors'},
      'strict-legal-basis|s'             => \$opts{'strict-legal-basis'},
      'min-tcf-policy-version|m=i'       => \$opts{'min-tcf-policy-version'},
      'cmp-validator=s'                  => \$opts{'cmp-validator'},
      'cmp-validator-network-ok'         => \$opts{'cmp-validator-network-ok'},
      'cmp-validator-verify-ssl!'        => \$opts{'cmp-validator-verify-ssl'},
      'cmp-validator-timeout=i'          => \$opts{'cmp-validator-timeout'},
      'all|a'                            => \$opts{all},
      'text|t'                           => \$opts{text},
      'help'                             => sub {
        pod2usage(-input => $script_path, -exitval => 1, -verbose => 99, -sections => "VALIDATE|BUGS");
      },
      'h' => sub { _show_subcommand_short_help('validate'); exit 1; },
    );
    @args = @ARGV;
  }
  $getopt_ok or pod2usage(-input => $script_path, -exitval => 2, -verbose => 99, -sections => "VALIDATE/Usage");

  unless (defined $opts{'vendor-id'}) {
    pod2usage(
      -input    => $script_path,
      -exitval  => 2,
      -message  => "validate: --vendor-id|-v is required",
      -verbose  => 99,
      -sections => "VALIDATE/Usage"
    );
  }

  require GDPR::IAB::TCFv2::Validator;

  my %vargs = (
    vendor_id                => $opts{'vendor-id'},
    verify_disclosed_vendors => $opts{'verify-disclosed-vendors'},
    strict_legal_basis       => $opts{'strict-legal-basis'},
  );
  $vargs{consent_purpose_ids} = _parse_id_list($opts{'consent-purposes'}) if defined $opts{'consent-purposes'};
  $vargs{legitimate_interest_purpose_ids} = _parse_id_list($opts{'legitimate-interest-purposes'})
    if defined $opts{'legitimate-interest-purposes'};
  $vargs{flexible_purpose_ids}   = _parse_id_list($opts{'flexible-purposes'}) if defined $opts{'flexible-purposes'};
  $vargs{min_tcf_policy_version} = $opts{'min-tcf-policy-version'} if defined $opts{'min-tcf-policy-version'};

  if (defined $opts{'cmp-validator'}) {
    require GDPR::IAB::TCFv2::CMPValidator;

    my $src      = $opts{'cmp-validator'};
    my %cmp_args = (verify_ssl => $opts{'cmp-validator-verify-ssl'}, timeout => $opts{'cmp-validator-timeout'},);

    if ($src =~ m{^https?://}i) {
      $cmp_args{url}        = $src;