File Coverage

blib/lib/JSON/Schema/Modern/Vocabulary.pm

Criterion	Covered	Total	%
statement	106	113	93.8
branch	15	18	83.3
condition			n/a
subroutine	24	26	92.3
pod	8	9	88.8
total	153	166	92.1

use strict;
use warnings;
package JSON::Schema::Modern::Vocabulary;
# vim: set ts=8 sts=2 sw=2 tw=100 et :
# ABSTRACT: Base role for JSON Schema vocabulary classes

our $VERSION = '0.632';

use 5.020;
use Moo::Role;
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';
no if "$]" >= 5.041009, feature => 'smartmatch';
no feature 'switch';
use JSON::Schema::Modern::Utilities qw(jsonp assert_keyword_type abort);
use Carp ();
use namespace::clean;

our @CARP_NOT = qw(JSON::Schema::Modern);

requires qw(vocabulary keywords);

sub evaluation_order { 999 }  # override, if needed

sub BUILD { die 'these classes are never instantiated' }

sub traverse ($class, $schema, $state) {
  $state->{evaluator}->_traverse_subschema($schema, $state);
}

sub traverse_subschema ($class, $schema, $state) {
  $state->{evaluator}->_traverse_subschema($schema->{$state->{keyword}},
    +{ %$state, keyword_path => $state->{keyword_path}.'/'.$state->{keyword} });
}

sub traverse_array_schemas ($class, $schema, $state) {
  return if not assert_keyword_type($state, $schema, 'array');
  return E($state, '%s array is empty', $state->{keyword}) if not $schema->{$state->{keyword}}->@*;

  my $valid = 1;
  foreach my $idx (0 .. $schema->{$state->{keyword}}->$#*) {
    $valid = 0 if not $state->{evaluator}->_traverse_subschema($schema->{$state->{keyword}}[$idx],
      +{ %$state, keyword_path => $state->{keyword_path}.'/'.$state->{keyword}.'/'.$idx });
  }
  return $valid;
}

sub traverse_object_schemas ($class, $schema, $state) {
  return if not assert_keyword_type($state, $schema, 'object');

  my $valid = 1;
  foreach my $property (sort keys $schema->{$state->{keyword}}->%*) {
    $valid = 0 if not $state->{evaluator}->_traverse_subschema($schema->{$state->{keyword}}{$property},
      +{ %$state, keyword_path => jsonp($state->{keyword_path}, $state->{keyword}, $property) });
  }
  return $valid;
}

sub traverse_property_schema ($class, $schema, $state, $property) {
  return if not assert_keyword_type($state, $schema, 'object');

  $state->{evaluator}->_traverse_subschema($schema->{$state->{keyword}}{$property},
    +{ %$state, keyword_path => jsonp($state->{keyword_path}, $state->{keyword}, $property) });
}

sub eval ($class, $data, $schema, $state) {
  $state->{evaluator}->_eval_subschema($data, $schema, $state);
}

sub eval_subschema_at_uri ($class, $data, $schema, $state, $uri) {
  my $schema_info = $state->{evaluator}->_fetch_from_uri($uri);
  abort($state, 'EXCEPTION: unable to find resource "%s"', $uri) if not $schema_info;
  abort($state, 'EXCEPTION: bad reference to "%s": not a schema', $schema_info->{canonical_uri})
    if $schema_info->{document}->get_entity_at_location($schema_info->{document_path}) ne 'schema';

  my $scope_uri = $schema_info->{canonical_uri}->clone->fragment(undef);
  push $state->{dynamic_scope}->@*, $scope_uri if $state->{dynamic_scope}->[-1] ne $scope_uri;

  return $state->{evaluator}->_eval_subschema($data, $schema_info->{schema},
    +{
      %$state,
      # keyword is assumed to be json pointer-encoded (if a suffix path is needed), so we just concat
      traversed_keyword_path => $state->{traversed_keyword_path}.$state->{keyword_path}.'/'.$state->{keyword},
      initial_schema_uri => $schema_info->{canonical_uri},
      $schema_info->%{qw(document specification_version vocabularies)},
      keyword_path => '',
    });
}

1;

__END__