1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
use strict;
use warnings;
package JSON::Schema::Modern::ResultNode;
# vim: set ts=8 sts=2 sw=2 tw=100 et :
# ABSTRACT: Common code for nodes of a JSON::Schema::Modern::Result
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 Safe::Isa;
use Types::Standard qw(Str Undef InstanceOf);
use Types::Common::Numeric 'PositiveOrZeroInt';
use JSON::Schema::Modern::Utilities qw(jsonp json_pointer_type);
use namespace::clean;
# not provided when Error and mode = traverse
has instance_location => (
is => 'ro',
isa => json_pointer_type,
);
has keyword_location => (
is => 'ro',
isa => json_pointer_type,
required => 1,
);
has absolute_keyword_location => (
is => 'ro',
isa => InstanceOf['Mojo::URL']|Undef,
lazy => 1,
default => sub ($self) {
# _uri contains data as populated from A() and E():
# [ $state->{initial_schema_uri}, $state->{keyword_path}, @extra_path ]
# we do the equivalent of:
# canonical_uri($state, @extra_path);
if (my $uri_bits = delete $self->{_uri}) {
my ($initial_schema_uri, $keyword_path, @extra_path) = @$uri_bits;
return($initial_schema_uri eq '' && $self->{keyword_location} eq '' ? undef : $initial_schema_uri)
if not @extra_path and not length($keyword_path);
my $uri = $initial_schema_uri->clone;
my $fragment = ($uri->fragment//'').(@extra_path ? jsonp($keyword_path, @extra_path) : $keyword_path);
undef $fragment if not length($fragment);
$uri->fragment($fragment);
undef $uri if $uri eq '' and $self->{keyword_location} eq ''
or ($uri->fragment // '') eq $self->{keyword_location} and $uri->clone->fragment(undef) eq '';
return $uri;
}
return;
},
);
has keyword => (
is => 'ro',
isa => Str|Undef,
required => 1,
);
has depth => (
is => 'ro',
isa => PositiveOrZeroInt,
required => 1,
);
# TODO: maybe need to support being passed an already-blessed object
sub BUILD ($self, $args) {
$self->{_uri} = $args->{_uri} if exists $args->{_uri};
}
sub TO_JSON ($self) {
my $thing = $self->__thing; # annotation or error
return +{
# note that locations are JSON pointers, not uri fragments!
!defined($self->instance_location) ? () : (instanceLocation => $self->instance_location),
keywordLocation => $self->keyword_location,
!defined($self->absolute_keyword_location) ? ()
: (absoluteKeywordLocation => $self->absolute_keyword_location->to_string),
$thing => $self->$thing, # TODO: allow localization in error message
};
}
sub dump ($self) {
my $encoder = JSON::Schema::Modern::_JSON_BACKEND()->new
->utf8(0)
->convert_blessed(1)
->canonical(1)
->indent(1)
->space_after(1);
$encoder->indent_length(2) if $encoder->can('indent_length');
$encoder->encode($self);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
JSON::Schema::Modern::ResultNode - Common code for nodes of a JSON::Schema::Modern::Result
=head1 VERSION
version 0.632
=head1 SYNOPSIS
use Moo;
with JSON::Schema::Modern::ResultNode;
=head1 DESCRIPTION
This module is for internal use only.
=for Pod::Coverage BUILD TO_JSON absolute_keyword_location depth dump instance_location keyword keyword_location
=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
|
