#!/usr/bin/env perl

use strict;
use warnings;

use Getopt::Long
  qw(GetOptionsFromArray :config pass_through require_order bundling);
use Pod::Usage;
use File::Spec;
eval { require JSON; 1 } or require JSON::PP;
use GDPR::IAB::TCFv2;

use constant {
    EXIT_SUCCESS     => 0,
    EXIT_PARSE_ERROR => 1,
};

my $script_path = File::Spec->rel2abs($0);

sub _json_false {
    return JSON->can('false') ? JSON->false() : JSON::PP::false();
}

sub _json_true {
    return JSON->can('true') ? JSON->true() : JSON::PP::true();
}

my %global_opts;
GetOptions(
    'help|h'    => \$global_opts{help},
    'man'       => \$global_opts{man},
    'version|V' => \$global_opts{version},
  )
  or pod2usage(
    -input    => $script_path, -exitval => 2, -verbose => 99,
    -sections => "SYNOPSIS|OPTIONS|SUBCOMMANDS|BUGS"
  );

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

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

my $subcommand = shift @ARGV || 'help';

if ( $subcommand eq 'dump' ) {
    run_dump(@ARGV);
}
elsif ( $subcommand eq 'validate' ) {
    run_validate(@ARGV);
}
elsif ( $subcommand eq 'help' ) {
    _show_help( shift @ARGV );
}
else {
    warn "Unknown subcommand: $subcommand\n";
    pod2usage(
        -input    => $script_path, -exitval => 1, -verbose => 99,
        -sections => "SYNOPSIS|OPTIONS|SUBCOMMANDS|BUGS"
    );
}

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

    GetOptionsFromArray(
        \@args,
        'pretty|p'           => \$opts{pretty},
        'json-array'         => \$opts{'json-array'},
        '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|s'           => \$opts{strict},
        'help|h'             => sub {
            pod2usage(
                -input    => $script_path, -exitval => 1, -verbose => 99,
                -sections => "DUMP|BUGS"
            );
        },
      )
      or pod2usage(
        -input    => $script_path, -exitval => 2, -verbose => 99,
        -sections => "DUMP|BUGS"
      );

    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');
    }
    if ( $opts{'json-array'} && !$opts{'quiet'} ) {
        print "[\n";
    }

    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, ':utf8' ) if -t STDIN;
        while ( my $line = <STDIN> ) {
            $state->{line_num}++;
            chomp $line;
            next unless $line =~ /\S/;
            _process_string( $line, $state, \%opts, $json );
        }
    }


    if ( $opts{'json-array'} && !$opts{'quiet'} ) {
        print "\n]\n";
    }

    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},
        );
        $output_data = $tcf->TO_JSON;
    };
    if ( my $err = $@ ) {
        if ( $o->{'fail-fast'} ) {
            warn
              "Fatal: Failed to parse TC string '$str' at line $state->{line_num}: $err\n"
              if $o->{'enable-warnings'};
            exit EXIT_PARSE_ERROR;
        }

        warn
          "Warning: Failed to parse TC string '$str' at line $state->{line_num}: $err\n"
          if $o->{'enable-warnings'};

        return if $o->{'ignore-errors'};

        chomp $err;
        $output_data = {
            tc_string => $str,
            error     => $err,
            success   => _json_false(),
        };

        if ( $o->{'errors-to-stderr'} ) {
            warn $j->encode($output_data) . "\n";
            return;
        }
    }

    return if $o->{'quiet'};

    my $out = $j->encode($output_data);

    if ( $o->{'json-array'} ) {
        print ",\n" if $state->{count} > 0;
        print $o->{pretty} ? _indent($out) : $out;
    }
    else {
        print "$out\n";
    }

    $state->{count}++;
}

sub _indent {
    my $text = shift;
    $text =~ s/^/    /mg;
    return $text;
}

sub _show_help {
    my $topic = shift;

    if ( $topic && $topic eq 'dump' ) {
        pod2usage(
            -input    => $script_path, -exitval => 1, -verbose => 99,
            -sections => "DUMP|BUGS"
        );
    }
    if ( $topic && $topic eq 'validate' ) {
        pod2usage(
            -input    => $script_path, -exitval => 1, -verbose => 99,
            -sections => "VALIDATE|BUGS"
        );
    }
    pod2usage(
        -input    => $script_path, -exitval => 1, -verbose => 99,
        -sections => "SYNOPSIS|OPTIONS|SUBCOMMANDS|BUGS"
    );
}

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 {
    my @args = @_;
    my %opts = (
        pretty                         => 0,
        'json-array'                   => 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,
        'check-disclosed-vendors'      => 0,
        strict                         => 0,
        'min-policy-version'           => undef,
        all                            => 0,
        text                           => 0,
    );

    GetOptionsFromArray(
        \@args,
        'pretty|p'                         => \$opts{pretty},
        'json-array'                       => \$opts{'json-array'},
        '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'},
        'check-disclosed-vendors|d' => \$opts{'check-disclosed-vendors'},
        'strict|s'                  => \$opts{strict},
        'min-policy-version|m=i'    => \$opts{'min-policy-version'},
        'all|a'                     => \$opts{all},
        'text|t'                    => \$opts{text},
        'help|h'                    => sub {
            pod2usage(
                -input    => $script_path, -exitval => 1, -verbose => 99,
                -sections => "VALIDATE|BUGS"
            );
        },
      )
      or pod2usage(
        -input    => $script_path, -exitval => 2, -verbose => 99,
        -sections => "VALIDATE|BUGS"
      );

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

    if ( $opts{'json-array'} && $opts{text} ) {
        warn "validate: --text and --json-array are mutually exclusive\n";
        pod2usage(
            -input    => $script_path, -exitval => 2, -verbose => 99,
            -sections => "VALIDATE|BUGS"
        );
    }

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

    my %vargs = (
        vendor_id               => $opts{'vendor-id'},
        check_disclosed_vendors => $opts{'check-disclosed-vendors'},
        strict                  => $opts{strict},
    );
    $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_policy_version} = $opts{'min-policy-version'}
      if defined $opts{'min-policy-version'};

    my $validator = eval { GDPR::IAB::TCFv2::Validator->new(%vargs) };
    if ( my $err = $@ ) {
        chomp $err;
        warn "validate: $err\n";
        exit 2;
    }

    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 $array_brackets =
      $opts{'json-array'} && !$opts{quiet} && !$opts{text};

    print "[\n" if $array_brackets;

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

    if (@args) {
        foreach my $str (@args) {
            $state->{line_num}++;
            _validate_string( $str, $state, \%opts, $json, $validator );
        }
    }
    else {
        binmode( STDIN, ':utf8' ) if -t STDIN;
        while ( my $line = <STDIN> ) {
            $state->{line_num}++;
            chomp $line;
            next unless $line =~ /\S/;
            _validate_string( $line, $state, \%opts, $json, $validator );
        }
    }

    print "\n]\n" if $array_brackets;

    exit( $state->{any_fail} ? EXIT_PARSE_ERROR : EXIT_SUCCESS );
}

sub _validate_string {
    my ( $str, $state, $o, $j, $validator ) = @_;

    my $result = eval {
        $o->{all}
          ? $validator->validate_all($str)
          : $validator->validate($str);
    };
    if ( my $err = $@ ) {
        $state->{any_fail} = 1;

        if ( $o->{'fail-fast'} ) {
            warn
              "Fatal: Failed to parse TC string '$str' at line $state->{line_num}: $err\n"
              if $o->{'enable-warnings'};
            exit EXIT_PARSE_ERROR;
        }

        warn
          "Warning: Failed to parse TC string '$str' at line $state->{line_num}: $err\n"
          if $o->{'enable-warnings'};

        return if $o->{'ignore-errors'};

        chomp $err;
        my $output_data = {
            tc_string => $str,
            error     => $err,
            success   => _json_false(),
        };

        if ( $o->{'errors-to-stderr'} ) {
            if ( $o->{text} ) {
                warn "ERROR  $str: $err\n";
            }
            else {
                warn $j->encode($output_data) . "\n";
            }
            return;
        }

        return if $o->{quiet};
        _emit_validate( $output_data, $state, $o, $j );
        return;
    }

    my $output_data;
    if ( $result->is_valid ) {
        $output_data = {
            tc_string => $str,
            vendor_id => $o->{'vendor-id'},
            valid     => _json_true(),
        };
    }
    else {
        $state->{any_fail} = 1;
        my @reasons = $result->reasons;
        $output_data = {
            tc_string => $str,
            vendor_id => $o->{'vendor-id'},
            valid     => _json_false(),
            $o->{all} ? ( reasons => \@reasons ) : ( reason => $reasons[0] ),
        };
    }

    return if $o->{quiet};

    _emit_validate( $output_data, $state, $o, $j );

    if ( !$result->is_valid && $o->{'fail-fast'} ) {
        print "\n]\n" if $o->{'json-array'} && !$o->{text};
        exit EXIT_PARSE_ERROR;
    }

    return;
}

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

    if ( $o->{text} ) {
        my $tc  = $output_data->{tc_string};
        my $vid = $output_data->{vendor_id};
        my $line;
        if ( exists $output_data->{error} ) {
            $line = "ERROR  $tc: $output_data->{error}";
        }
        elsif ( $output_data->{valid} ) {
            $line = "OK     $tc vendor $vid";
        }
        else {
            my @reasons =
              $o->{all}
              ? @{ $output_data->{reasons} || [] }
              : ( $output_data->{reason} );
            if ( @reasons == 1 ) {
                $line = "FAIL   $tc vendor $vid: $reasons[0]";
            }
            else {
                $line = join "\n",
                  "FAIL   $tc vendor $vid:",
                  map { "  - $_" } @reasons;
            }
        }
        print "$line\n";
        $state->{count}++;
        return;
    }

    my $out = $j->encode($output_data);

    if ( $o->{'json-array'} ) {
        print ",\n" if $state->{count} > 0;
        print $o->{pretty} ? _indent($out) : $out;
    }
    else {
        print "$out\n";
    }
    $state->{count}++;

    return;
}

__END__

=encoding utf8

=head1 NAME

iabtcfv2 - CLI tool for GDPR IAB TCF v2 strings

=head1 SYNOPSIS

iabtcfv2 [options] <subcommand> [subcommand-options]

=head1 OPTIONS

=over 4

=item B<--help>, B<-h>

Print a brief help message and exits.

=item B<--version>, B<-V>

Print the version and exits.

=item B<--man>

Prints the manual page and exits.

=back

=head1 SUBCOMMANDS

=over 4

=item B<dump>

Parses TC strings and outputs them as JSON.

=item B<validate>

Validates TC strings against a vendor identity and a set of purpose lists,
emitting one JSON record per string (or text lines with B<--text>).

=back

=head1 DUMP

Parses TC strings and outputs them as JSON.

=head2 Options

=over 4

=item B<--pretty>, B<-p>

Output human-readable, indented JSON.

=item B<--json-array>

Output a single JSON array containing all parsed objects.

=item B<--compact>, B<-c>

Output a compact JSON representation (lists of IDs instead of boolean maps).

=item B<--vendor-id>, B<-v> I<ID>

Filter the output to only show data for a specific vendor ID.

=item B<--strict>, B<-s>

Enable strict specification validation. In this mode, the tool will fail if
mandatory segments are missing (e.g., Disclosed Vendors in TCF v2.3).

=item B<--ignore-errors>, B<-i>

Do not output any JSON error object for failed strings.

=item B<--fail-fast>, B<-f>

Stop processing and exit the program immediately upon the first parse error.

=item B<--errors-to-stderr>, B<-e>

Output JSON error objects to B<STDERR> instead of B<STDOUT>.

=item B<--enable-warnings>, B<-w>

Emit human-readable warning messages on B<STDERR> when a TC string fails to
parse. Off by default; enable to get diagnostic context alongside the JSON
error object.

=item B<--quiet>, B<-q>

Suppress all output on B<STDOUT>. The exit code still reflects whether parsing
succeeded, which is convenient for shell-style C<if iabtcfv2 dump -q "$tc">
checks. Combine with C<--enable-warnings> if you want diagnostics on B<STDERR>.

=back

=head2 Examples

    # Dump a string to JSON line
    iabtcfv2 dump CPi...AAA

    # Dump multiple strings to a pretty-printed JSON array
    iabtcfv2 dump --pretty --json-array CPi...AAA CPj...BBB

    # Read from STDIN
    cat strings.txt | iabtcfv2 dump --json-array

=head2 Short option bundling

Single-character flags can be bundled together after a single dash. The last
option in the bundle may take a value as the next argument.

    # Equivalent of `--pretty --ignore-errors`
    iabtcfv2 dump -pi CPi...AAA

    # Equivalent of `--compact --pretty`
    iabtcfv2 dump -cp CPi...AAA

    # Last bundled short can take a value: -p (pretty) + -v <id> (vendor-id)
    iabtcfv2 dump -pv 284 CPi...AAA

    # Long options accept the GNU `=value` form too
    iabtcfv2 dump --vendor-id=284 CPi...AAA

Bundling does NOT support abbreviating long options (`--ver` is not accepted
as a shortcut for `--version`); always use the full long-option name or its
single-character short alias.

=head1 DOCKER USAGE

This tool is also available as a Docker image on Docker Hub.

=head2 Basic Usage

    docker run --rm peczenyj/gdpr-iab-tcfv2 dump "CLcVDxRMWfGmWAVAHCENAXCkAKDAADnAABRgA5mdfCKZuYJez-NQm0TBMYA4oCAAGQYIAAAAAAEAIAEgAA"

=head2 Processing Streams (STDIN)

To process a stream of strings via pipe:

    cat strings.txt | docker run -i --rm peczenyj/gdpr-iab-tcfv2 dump

To type strings manually:

    docker run -it --rm peczenyj/gdpr-iab-tcfv2 dump

=head1 VALIDATE

Validates TC strings against a vendor identity and a set of declared purpose
lists. The vendor must be allowed for every purpose in C<--consent-purposes>
on a consent basis, and for every purpose in
C<--legitimate-interest-purposes> on a legitimate-interest basis. Purposes
listed in C<--flexible-purposes> are checked using the GVL flexible-purpose
semantics, with the default basis derived from which list also contains the
purpose. See L<GDPR::IAB::TCFv2::Validator> for the underlying rule engine.

By default the subcommand emits one JSON object per input TC string on
B<STDOUT>. With B<--text> it emits one human-readable line per string
instead.

=head2 Output shape

A successful validation produces:

    {"tc_string":"CO...","vendor_id":32,"valid":true}

A failure in default (fail-fast) mode produces a singular C<reason>:

    {"tc_string":"CO...","vendor_id":32,"valid":false,
     "reason":"vendor 32 not allowed for purpose 1 (consent)"}

A failure in B<--all> mode produces a plural C<reasons> array:

    {"tc_string":"CO...","vendor_id":32,"valid":false,
     "reasons":["...","..."]}

A parse error produces the same shape as the C<dump> subcommand:

    {"tc_string":"INVALID","error":"...","success":false}

=head2 Required options

=over 4

=item B<--vendor-id>, B<-v> I<ID>

The numeric vendor ID to validate against. Required.

=back

=head2 Purpose options

=over 4

=item B<--consent-purposes>, B<-C> I<1,2,3>

Comma-separated list of purpose IDs that the vendor must be allowed to
process on a B<consent> basis.

=item B<--legitimate-interest-purposes>, B<-L> I<1,2,3>

Comma-separated list of purpose IDs that the vendor must be allowed to
process on a B<legitimate interest> basis.

=item B<--flexible-purposes>, B<-F> I<1,2,3>

Comma-separated list of purpose IDs that the vendor declared as flexible.
Each ID listed here MUST also appear in either C<--consent-purposes> or
C<--legitimate-interest-purposes>; the membership determines the default
legal basis used for the flexible-purpose check.

=back

=head2 Rule options

=over 4

=item B<--check-disclosed-vendors>, B<-d>

Require the vendor to appear in the Disclosed Vendors segment when the TC
string carries one. Off by default.

=item B<--strict>, B<-s>

Enable strict spec validation in the underlying parser (see C<dump --strict>).

=item B<--min-policy-version>, B<-m> I<N>

Reject TC strings whose Global Vendor List policy version is below I<N>.
Checked first, before any vendor- or purpose-level rules.

=item B<--all>, B<-a>

Accumulate every failing rule into a C<reasons> array instead of
short-circuiting on the first failure. The output JSON uses plural
C<reasons> (array) instead of singular C<reason> (string).

=back

=head2 Output options

=over 4

=item B<--pretty>, B<-p>

Output human-readable, indented JSON.

=item B<--json-array>

Output a single JSON array containing all validation records.

=item B<--text>, B<-t>

Output one human-readable line per TC string instead of JSON. Format:

    OK     <tc>  vendor <id>
    FAIL   <tc>  vendor <id>: <reason>
    ERROR  <tc>: <parse error>

In B<--all> mode, multi-reason failures span multiple indented lines.
Mutually exclusive with C<--json-array>.

=item B<--ignore-errors>, B<-i>

Skip parse errors silently (still bumps the exit code). Validation failures
are still emitted.

=item B<--fail-fast>, B<-f>

Exit immediately on the first parse error or the first invalid TC string.
Validation failures are emitted before exiting; parse errors are not (matches
the C<dump> contract).

=item B<--errors-to-stderr>, B<-e>

Route parse-error records to B<STDERR> instead of B<STDOUT>.

=item B<--enable-warnings>, B<-w>

Emit human-readable warning messages on B<STDERR> when a TC string fails to
parse. Off by default.

=item B<--quiet>, B<-q>

Suppress all output on B<STDOUT>. The exit code still reflects validity,
which is convenient for shell-style C<if iabtcfv2 validate -q -v 32 ... "$tc">
checks.

=back

=head2 Exit codes

=over 4

=item *

B<0> — every input TC string was parsed and validated cleanly.

=item *

B<1> — at least one TC string failed validation or could not be parsed.

=item *

B<2> — bad CLI usage (missing C<--vendor-id>, incoherent purpose lists,
mutually exclusive flags).

=back

=head2 Examples

    # Single string, fail-fast
    iabtcfv2 validate -v 32 -C 1,3 -L 7 CO...AAA

    # All reasons, pretty JSON, text-friendly
    iabtcfv2 validate -av 32 -C 1,3 -L 7 -t CO...AAA

    # Pipeline-friendly: just the exit code
    if iabtcfv2 validate -q -v 32 -C 1,3 "$tc"; then ...

    # Many strings as a single JSON array
    iabtcfv2 validate -v 32 -C 1,3 --json-array CO...AAA CO...BBB

=head1 DESCRIPTION

B<iabtcfv2> is a command-line interface for the GDPR::IAB::TCFv2 library.

=head2 B<Warning: Name Change>

Previous versions of this distribution (v0.300) included a standalone utility
named B<iabtcf-dump>. This has been unified into the B<iabtcfv2> tool using
the B<dump> subcommand.

=head1 BUGS

Report bugs and feature requests at L<https://github.com/peczenyj/GDPR-IAB-TCFv2/issues>.

=cut
