File Coverage

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

Criterion	Covered	Total	%
statement	48	50	96.0
branch	4	8	50.0
condition			n/a
subroutine	15	16	93.7
pod	6	6	100.0
total	73	80	91.2

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

our $VERSION = '0.028';

use 5.016;
no if "$]" >= 5.031009, feature => 'indirect';
no if "$]" >= 5.033001, feature => 'multidimensional';
no if "$]" >= 5.033006, feature => 'bareword_filehandles';
use strictures 2;
use JSON::Schema::Draft201909::Utilities qw(jsonp assert_keyword_type);
use Moo::Role;
use namespace::clean;

requires qw(vocabulary keywords);

sub traverse {
  my ($self, $schema, $state) = @_;
  $state->{evaluator}->_traverse($schema, $state);
}

sub traverse_subschema {
  my ($self, $schema, $state) = @_;

  $state->{evaluator}->_traverse($schema->{$state->{keyword}},
    +{ %$state, schema_path => $state->{schema_path}.'/'.$state->{keyword} });
}

sub traverse_array_schemas {
  my ($self, $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}}};

  foreach my $idx (0 .. $#{$schema->{$state->{keyword}}}) {
    $state->{evaluator}->_traverse($schema->{$state->{keyword}}[$idx],
      +{ %$state, schema_path => $state->{schema_path}.'/'.$state->{keyword}.'/'.$idx });
  }
}

sub traverse_object_schemas {
  my ($self, $schema, $state) = @_;

  return if not assert_keyword_type($state, $schema, 'object');

  foreach my $property (sort keys %{$schema->{$state->{keyword}}}) {
    $state->{evaluator}->_traverse($schema->{$state->{keyword}}{$property},
      +{ %$state, schema_path => jsonp($state->{schema_path}, $state->{keyword}, $property) });
  }
}

sub traverse_property_schema {
  my ($self, $schema, $state, $property) = @_;

  return if not assert_keyword_type($state, $schema, 'object');

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

sub eval {
  my ($self, $data, $schema, $state) = @_;
  $state->{evaluator}->_eval($data, $schema, $state);
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

JSON::Schema::Draft201909::Vocabulary - Base role for JSON Schema vocabulary classes

=head1 VERSION

version 0.028

=head1 SYNOPSIS

  package MyApp::Vocabulary::Awesome;
  use Moo::Role;
  with 'JSON::Schema::Draft201909::Vocabulary';

=head1 DESCRIPTION

This package is the role which all all vocabulary classes for L<JSON::Schema::Draft201909>
must compose, describing the basic structure expected of a vocabulary class.

User-defined custom vocabularies are not supported at this time.

=head1 ATTRIBUTES

=head1 METHODS

=for stopwords schema subschema

=head2 vocabulary

The canonical URI describing the vocabulary, as described in
L<JSON Schema Core Meta-specification, section 8.1.2|https://json-schema.org/draft/2019-09/json-schema-core.html#rfc.section.8.1.2>. Must be implemented by the composing class.

=head2 keywords

The list of keywords defined by the vocabulary. Must be implemented by the composing class.

=head2 traverse

Traverses a subschema.

=head2 traverse_subschema

Recursively traverses the schema at the current keyword.

=head2 traverse_array_schemas

Recursively traverses the list of subschemas at the current keyword.

=head2 traverse_object_schemas

Recursively traverses the (subschema) values of the object at the current keyword.

=head2 traverse_property_schema

Recursively traverses the subschema under one property of the object at the current keyword.

=head2 eval

Evaluates a subschema.

=head1 SUPPORT

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

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

=head1 AUTHOR

Karen Etheridge <[e-mail]>

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

=cut