File Coverage

blib/lib/JSONSchema/Validator/JSONPointer.pm
Criterion Covered Total %
statement 85 89 95.5
branch 29 40 72.5
condition 24 29 82.7
subroutine 19 19 100.0
pod 0 12 0.0
total 157 189 83.0


line stmt bran cond sub pod time code
1             package JSONSchema::Validator::JSONPointer;
2              
3             # ABSTRACT: JSON Pointer with URI resolving
4              
5 6     6   35 use strict;
  6         10  
  6         162  
6 6     6   26 use warnings;
  6         11  
  6         165  
7 6     6   29 use URI;
  6         17  
  6         146  
8 6     6   30 use Carp 'croak';
  6         17  
  6         260  
9              
10 6     6   34 use Scalar::Util 'weaken';
  6         10  
  6         461  
11              
12             use overload
13 1134     1134   1717 'bool' => sub { $_[0]->value },
14 6     6   34 fallback => 1;
  6         12  
  6         45  
15              
16             our @ISA = 'Exporter';
17             our @EXPORT_OK = qw(json_pointer);
18              
19             sub json_pointer {
20 5904     5904 0 14201 return __PACKAGE__;
21             }
22              
23             sub append {
24 5762     5762 0 9646 my ($class, $path, @values) = @_;
25 5762         8105 my $suffix = join('/', map { $class->escape($_) } @values);
  5762         9343  
26 5762 100       20509 return $path =~ m!/$!
27             ? $path . $suffix
28             : $path . '/' . $suffix;
29             }
30              
31             sub join {
32 67     67 0 111 my ($class, @parts) = @_;
33 67         99 return '/' . join('/', map { $class->escape($_) } @parts);
  67         102  
34             }
35              
36             sub escape {
37 5829     5829 0 8181 my ($class, $value) = @_;
38 5829         8919 $value =~ s!~!~0!g;
39 5829         7591 $value =~ s!/!~1!g;
40 5829         13337 return $value;
41             }
42              
43             sub unescape {
44 379     379 0 589 my ($class, $value) = @_;
45 379         573 $value =~ s!~1!/!g;
46 379         541 $value =~ s!~0!~!g;
47 379         794 return $value;
48             }
49              
50             sub new {
51 1114     1114 0 2612 my ($class, %params) = @_;
52              
53 1114         2027 my ($scope, $value, $validator) = @params{qw/scope value validator/};
54              
55 1114 50       1814 croak 'JSONPointer: scope is required' unless defined $scope;
56 1114 50       1774 croak 'JSONPointer: validator is required' unless $validator;
57              
58 1114         2384 weaken($validator);
59              
60 1114         2487 my $self = {
61             scope => $scope,
62             value => $value,
63             validator => $validator
64             };
65              
66 1114         1579 bless $self, $class;
67              
68 1114         3273 return $self;
69             }
70              
71 3107     3107 0 5748 sub validator { shift->{validator} }
72 1156     1156 0 2045 sub scope { shift->{scope} }
73 2651     2651 0 5115 sub value { shift->{value} }
74              
75             sub xget {
76 928     928 0 1618 my ($self, @parts) = @_;
77              
78 928         1441 my $current_scope = $self->scope;
79 928         1311 my $current_value = $self->value;
80              
81 928   66     2984 while (ref $current_value eq 'HASH' && $current_value->{'$ref'}) {
82 0         0 my $ref = URI->new($current_value->{'$ref'});
83 0 0       0 $ref = $ref->abs($current_scope) if $current_scope;
84 0         0 ($current_scope, $current_value) = $self->validator->resolver->resolve($ref);
85             }
86              
87 928 100 100     1952 if (ref $current_value eq 'HASH' && $self->validator->using_id_with_ref) {
88 114         180 my $id = $current_value->{$self->validator->ID_FIELD};
89 114 100 66     358 if ($id && !ref $id) {
90 89 50       285 $current_scope = $current_scope
91             ? URI->new($id)->abs($current_scope)->as_string
92             : $id;
93             }
94             }
95              
96 928         7842 for my $part (@parts) {
97 1184 100 100     4359 if (ref $current_value eq 'HASH' && exists $current_value->{$part}) {
    100 66        
      66        
98 914         1425 $current_value = $current_value->{$part};
99             } elsif (ref $current_value eq 'ARRAY' && $part =~ m/^\d+$/ && scalar(@$current_value) > $part) {
100 67         123 $current_value = $current_value->[$part];
101             } else {
102 203         262 $current_value = undef;
103 203         280 last;
104             }
105              
106 981   100     3049 while (ref $current_value eq 'HASH' && $current_value->{'$ref'}) {
107 38         158 my $ref = URI->new($current_value->{'$ref'});
108 38 100       1751 $ref = $ref->abs($current_scope) if $current_scope;
109 38         494 ($current_scope, $current_value) = $self->validator->resolver->resolve($ref);
110             }
111              
112 981 100 100     2207 if (ref $current_value eq 'HASH' && $self->validator->using_id_with_ref) {
113 230         367 my $id = $current_value->{$self->validator->ID_FIELD};
114 230 100 66     558 if ($id && !ref $id) {
115 2 50       9 $current_scope = $current_scope
116             ? URI->new($id)->abs($current_scope)->as_string
117             : $id;
118             }
119             }
120             }
121              
122 928         1455 return __PACKAGE__->new(
123             value => $current_value,
124             scope => $current_scope,
125             validator => $self->validator
126             )
127             }
128              
129             sub get {
130             # pointer is string which is already urldecoded and utf8-decoded
131 209     209 0 373 my ($self, $pointer) = @_;
132 209 50       371 return $self unless $pointer;
133              
134 209 50       972 croak "Invalid JSON Pointer $pointer" unless $pointer =~ s!^/!!;
135              
136             my @parts = length $pointer
137 209 100       968 ? map { $self->unescape($_) } split(/\//, $pointer, -1)
  379         720  
138             : ('');
139              
140 209         479 return $self->xget(@parts);
141             }
142              
143             sub keys {
144 61     61 0 141 my ($self, %params) = @_;
145 61   100     157 my $raw = $params{raw} // 0;
146              
147 61 100       119 if (ref $self->value eq 'HASH') {
148 34 50       54 return map { $raw ? $_ : $self->join($_) } keys %{$self->value};
  41         169  
  34         72  
149             }
150              
151 27 50       52 if (ref $self->value eq 'ARRAY') {
152 27 50       43 return map { $raw ? $_ : $self->join($_) } 0 .. $#{$self->value};
  67         137  
  27         44  
153             }
154              
155 0           return;
156             }
157              
158             1;
159              
160             __END__