#!/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 Path::Tiny;
use Safe::Isa;
use Feature::Compat::Try;
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
  [],
  ['validate-schema:s', 'validate the provided schema against its meta-schema and the specification. do not provide --data or --schema.' ],
  ['add-schema=s@', 'the filename of an extra schema to load, so it can be used by $ref' ],
  ['data=s', 'the filename to use for the instance data (if not provided, STDIN is used)'],
  ['schema=s', 'the filename to use for the schema (if not provided, STDIN is used)'],
  ['dump-identifiers', 'print a list of all identifiers found in the schema'],
);

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

my ($data, $schema, $validate_schema) = delete $opt->@{qw(data schema validate_schema)};

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

my $js = JSON::Schema::Modern->new(%$opt);
my $decoder = JSON::Schema::Modern::_JSON_BACKEND()->new->allow_nonref(1)->utf8(0);

foreach my $add_schema_file (@{$opt->add_schema//[]}) {
  try {
    $js->add_schema('file://'.$add_schema_file => $decoder->decode(path($add_schema_file)->slurp_utf8));
  }
  catch ($e) {
    say $e->$_isa('JSON::Schema::Modern::Result') ? $e->dump: '"'.$e.'"';
    exit 2;
  }
}

my $result;
my $schema_filename = '';

if (defined $validate_schema) {
  if (length $validate_schema) { # boolean flag is passed as ''; some other value = filename
    $schema = path($schema_filename = $validate_schema)->slurp_utf8;
  }
  else {
    say 'enter schema, followed by ^D:';
    local $/;
    $schema = <STDIN>;
    say '';
  }

  $schema = $decoder->decode($schema);
  $result = $js->validate_schema($schema);
}
else {
  if (defined $data) {
    $data = path($data)->slurp_utf8;
  }
  else {
    say 'enter data instance, followed by ^D:';
    local $/;
    $data = <STDIN>;
    STDIN->clearerr;
  }

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

  $data = $decoder->decode($data);
  $schema = $decoder->decode($schema);

  $result = $js->evaluate($data, $schema, { effective_base_uri => 'file://'.$schema_filename });
}

say $result->dump;

if ($opt->dump_identifiers) {
  $js->add_schema($schema) if $validate_schema;

  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;

  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');

  say $encoder->encode(\%identifiers);
}

exit($result->valid ? 0 : $result->exception ? 2 : 1);

__END__

=pod

=encoding UTF-8

=head1 NAME

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

=head1 VERSION

version 0.611

=head1 SYNOPSIS

  json-schema-eval \
    [ --specification_version|version <version> ] \
    [ --output_format <format> ] \
    [ --short_circuit ] \
    [ --max_traversal_depth <depth> ] \
    [ --validate_formats ] \
    [ --validate_content_schemas ] \
    [ --collect_annotations ] \
    [ --strict ] \
    [ --data <filename> ] \
    [ --schema <filename> ] \
    [ --validate-schema [filename] ]
    [ --add-schema <filename> ]
    [ --dump-identifiers ]

=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-encoded data instance,
and C<--schema> provides the filename containing a json-encoded schema.

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

Only JSON-encoded data and schemas are supported at this time.

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.

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 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