#!/usr/bin/perl
# vim: set ts=8 sts=2 sw=2 tw=100 et :
# PODNAME: json-schema-eval
# ABSTRACT: A command-line interface to JSON::Schema::Modern::evaluate()
use 5.020;  # for fc, unicode_strings features
use strictures 2;
use stable 0.031 'postderef';
use experimental 'signatures';
no autovivification warn => qw(fetch store exists delete);
use if "$]" >= 5.022, experimental => 're_strict';
no if "$]" >= 5.031009, feature => 'indirect';
no if "$]" >= 5.033001, feature => 'multidimensional';
no if "$]" >= 5.033006, feature => 'bareword_filehandles';
use open ':std', ':encoding(UTF-8)'; # force stdin, stdout, stderr into utf8

use Getopt::Long::Descriptive;
use Mojo::File 'path';
use Safe::Isa;
use Feature::Compat::Try;
use List::Util 'max';
use JSON::Schema::Modern;

my ($opt, $usage) = Getopt::Long::Descriptive::describe_options(
  "$0 %o",
  ['help|usage|?|h', 'print usage information and exit', { shortcircuit => 1 } ],
  [],
  ['specification-version|version=s', 'which version of the JSON Schema specification to use'],
  ['output-format=s', 'output format (flag, basic, terse)'],
  ['short-circuit', 'return early in any execution path as soon as the outcome can be determined'],
  ['max-traversal-depth=i', 'the maximum number of levels deep a schema traversal may go'],
  ['validate-formats', 'treat the "format" keyword as an assertion, not merely an annotation'],
  ['validate-content-schemas', 'treat the "contentMediaType" and "contentSchema" keywords as assertions'],
  ['collect-annotations', 'collect annotations'],
  ['strict', 'disallow unknown keywords'],
  # scalarref-booleans, stringy-numbers make no sense in json-encoded data
  ['dump-identifiers', 'print a list of all identifiers found in the schema'],
  ['with-defaults', 'include list of defaults for missing data'],
  [],
  ['validate-schema:s@', 'validate the provided schema against its meta-schema and the specification. do not provide --data or --schema; can be used more than once' ],
  ['add-schema=s@', 'the filename of an extra schema to load, so it can be used by $ref; can be used more than once' ],
  ['data=s@', 'the filename to use for the instance data (if not provided, STDIN is used); can be used more than once'],
  ['schema=s', 'the filename to use for the schema (if not provided, STDIN is used)'],
);

print($usage->text), exit if $opt->help;

die '--validate-schema and --data should not be used together' if defined $opt->data and defined $opt->validate_schema;
die '--validate-schema and --schema should not be used together' if defined $opt->schema and defined $opt->validate_schema;

my $js = JSON::Schema::Modern->new(%$opt);


foreach my $add_schema_file (($opt->add_schema//[])->@*) {
  try {
    my $schema = parse_input(path($add_schema_file)->slurp('UTF-8'));
    die "this looks like an OpenAPI file: try 'openapi-validate' (install OpenAPI::Modern), instead\n"
      if ref $schema eq 'HASH' and $schema->{openapi};
    $js->add_schema('file://'.$add_schema_file => $schema);
  }
  catch ($e) {
    say $e->$_isa('JSON::Schema::Modern::Result') ? $e->dump: '"'.$e.'"';
    exit 2;
  }
}

my $exit_val = 0;

if (defined $opt->validate_schema) {
  my $encoded_schema;

  foreach my $schema_filename ($opt->validate_schema->@*) {
    # boolean flag is passed as ''; some other value = filename
    if (length $schema_filename) {
      $encoded_schema = path($schema_filename)->slurp('UTF-8');
    }
    else {
      say 'enter schema, followed by ^D:';
      local $/;
      $encoded_schema = <STDIN>;
      say '';
    }

    my $schema = parse_input($encoded_schema);
    die "this looks like an OpenAPI file: try 'openapi-validate' (install OpenAPI::Modern), instead\n"
      if ref $schema eq 'HASH' and $schema->{openapi};

    my $result = $js->validate_schema($schema);
    $js->add_schema($schema) if $opt->dump_identifiers;

    $exit_val = max($exit_val, $result->valid ? 0 : $result->exception ? 2 : 1);

    # possible FIXME: can output_format ever be data_only here? it does not jsonify
    say encode($opt->validate_schema->@* > 1 ? { $schema_filename => $result } : $result);
  }
}
else {
  my @encoded_data;
  foreach my $data_filename (($opt->data//[''])->@*) {
    if (length $data_filename) {
      push @encoded_data, [ $data_filename => path($data_filename)->slurp('UTF-8') ];
    }
    else {
      say 'enter data instance, followed by ^D:';
      local $/;
      push @encoded_data, [ '' => <STDIN> ];
      STDIN->clearerr;
    }
  }

  my ($schema_filename, $encoded_schema);
  if (defined $opt->schema) {
    $encoded_schema = path($schema_filename = $opt->schema)->slurp('UTF-8');
  }
  else {
    say 'enter schema, followed by ^D:';
    local $/;
    $encoded_schema = <STDIN>;
    say '';
  }

  # if there is no $id within the document, the filename will be used instead
  my $schema = parse_input($encoded_schema);
  die "this looks like an OpenAPI file: try 'openapi-validate' (install OpenAPI::Modern), instead\n"
    if ref $schema eq 'HASH' and $schema->{openapi};
  $js->add_schema(my $uri = 'file://'.$schema_filename, $schema) if length $schema_filename;

  foreach my $encoded_data (@encoded_data) {  # [ filename, data string ]
    my $data = parse_input($encoded_data->[1]);

    my $result = $js->evaluate($data, $uri // $schema);
    $exit_val = max($exit_val, $result->valid ? 0 : $result->exception ? 2 : 1);

    # possible FIXME: can output_format ever be data_only here? it does not jsonify
    say encode(($opt->data//[])->@* > 1 ? { $encoded_data->[0] => $result } : $result);
  }
}


if ($opt->dump_identifiers) {
  my %identifiers = map +(
    $_->[0] => {
      canonical_uri => $_->[1]{canonical_uri},
      document_base => $_->[1]{document}->canonical_uri,
      document_path => $_->[1]{path},
    }
  ),
  grep $_->[0] !~ m{^https?://json-schema.org/},
  $js->_resource_pairs;

  say encode({identifiers => \%identifiers });
}

exit $exit_val;

### END

sub parse_input ($input) {
  if ($input =~ /^(\{|\[\|["0-9]|true\b|false\b|null\b)/) {
    # this looks like json
    state $json_decoder = JSON::Schema::Modern::_JSON_BACKEND()->new->allow_nonref(1)->utf8(0);
    return $json_decoder->decode($input);
  }
  else {
    # well I suppose it must be yaml
    require YAML::PP;
    state $yaml_decoder = YAML::PP->new(boolean => 'JSON::PP');
    return $yaml_decoder->load_string($input);
  }
}

sub encode ($input) {
  my $encoder = JSON::Schema::Modern::_JSON_BACKEND()->new
    ->convert_blessed(1)
    ->utf8(0)
    ->canonical(1)
    ->pretty(1);
  $encoder->indent_length(2) if $encoder->can('indent_length');
  $encoder->encode($input);
}

__END__

=pod

=encoding UTF-8

=head1 NAME

json-schema-eval - A command-line interface to JSON::Schema::Modern::evaluate()

=head1 VERSION

version 0.632

=head1 SYNOPSIS

  json-schema-eval --help

  json-schema-eval \
    [ --specification-version|version <version> ] \
    [ --output-format <format> ] \
    [ --short-circuit ] \
    [ --max-traversal-depth <depth> ] \
    [ --validate-formats ] \
    [ --validate-content-schemas ] \
    [ --collect-annotations ] \
    [ --strict ] \
    [ --dump-identifiers ] \
    [ --with-defaults ] \
    [ --validate-schema [ <filename> ] [ ... ] ] \
    [ --add-schema [ <filename> ] [ ... ] ] \
    [ --data [ <filename> ] [ ... ] ] \
    [ --schema [ <filename> ] ]

=head1 DESCRIPTION

A command-line interface to L<JSON::Schema::Modern/evaluate>.

F<data.json> contains:

  {"hello": 42.1}

F<schema.json> contains:

  {"properties": {"hello": {"type": ["string", "integer"]}}}

Run:

  json-schema-eval --data data.json --schema schema.json

produces output:

  {
    "errors" : [
      {
        "error" : "got number, not one of string, integer",
        "instanceLocation" : "/hello",
        "keywordLocation" : "/properties/hello/type"
      },
      {
        "error" : "not all properties are valid",
        "instanceLocation" : "",
        "keywordLocation" : "/properties"
      }
    ],
    "valid" : false
  }

Or run:

  json-schema-eval --validate-schema schema.json

produces output:

  {
    "valid": true
  }

The exit value (C<$?>) is 0 when the result is valid, 1 when it is invalid,
and some other non-zero value if an exception occurred.

=head1 OPTIONS

=for stopwords schemas

All boolean and string options used as L<constructors to
JSON::Schema::Modern|JSON::Schema::Modern/CONFIGURATION OPTIONS> are available.

Additionally, C<--data> is used to provide the filename containing a JSON- or YAML-encoded data
instance, and C<--schema> provides the filename containing a JSON- or YAML-encoded schema.
You can use the C<--data> option more than once to validate multiple data instances against the same
schema.

If either or both of these are not provided, STDIN is used as input.

Both JSON- and YAML-encoded data and schemas are supported, using heuristics based on the
content of the first line of the data.

Alternatively, you can use C<--validate-schema> and either provide a filename containing a
JSON-encoded schema, or omit the argument to read a schema from STDIN. The schema
will be evaluated against its meta-schema for the corresponding specification version.
You can use this option more than once to validate multiple schemas in the same runtime instance.

Additional schemas, that you wish to use via the C<$ref> keyword, can be added with
C<< --add-schema <filename> >>. The actual filename is insignificant: Make sure you use an C<$id>
keyword within that schema that matches the value you use in the C<$ref>. This option can be used
more than once.

=for stopwords OpenAPI

=head1 AVAILABILITY

This executable is available on modern Debian versions (via C<apt-get>) as the
C<libjson-schema-modern-perl> package.

=head1 GIVING THANKS

=for stopwords MetaCPAN GitHub

If you found this module to be useful, please show your appreciation by
adding a +1 in L<MetaCPAN|https://metacpan.org/dist/JSON-Schema-Modern>
and a star in L<GitHub|https://github.com/karenetheridge/JSON-Schema-Modern>.

=head1 SUPPORT

Bugs may be submitted through L<https://github.com/karenetheridge/JSON-Schema-Modern/issues>.

I am also usually active on irc, as 'ether' at C<irc.perl.org> and C<irc.libera.chat>.

=for stopwords OpenAPI

You can also find me on the L<JSON Schema Slack server|https://json-schema.slack.com> and L<OpenAPI Slack
server|https://open-api.slack.com>, which are also great resources for finding help.

=head1 AUTHOR

Karen Etheridge <ether@cpan.org>

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2020 by Karen Etheridge.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

Some schema files have their own licence, in share/LICENSE.

=cut