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   56 use strict;
  6         15  
  6         182  
6 6     6   30 use warnings;
  6         10  
  6         192  
7 6     6   37 use URI;
  6         20  
  6         212  
8 6     6   44 use Carp 'croak';
  6         19  
  6         311  
9              
10 6     6   41 use Scalar::Util 'weaken';
  6         12  
  6         599  
11              
12             use overload
13 983     983   1833 'bool' => sub { $_[0]->value },
14 6     6   42 fallback => 1;
  6         13  
  6         54  
15              
16             our @ISA = 'Exporter';
17             our @EXPORT_OK = qw(json_pointer);
18              
19             sub json_pointer {
20 5849     5849 0 13303 return __PACKAGE__;
21             }
22              
23             sub append {
24 5707     5707 0 11700 my ($class, $path, @values) = @_;
25 5707         10214 my $suffix = join('/', map { $class->escape($_) } @values);
  5707         10569  
26 5707 100       24528 return $path =~ m!/$!
27             ? $path . $suffix
28             : $path . '/' . $suffix;
29             }
30              
31             sub join {
32 61     61 0 104 my ($class, @parts) = @_;
33 61         99 return '/' . join('/', map { $class->escape($_) } @parts);
  61         100  
34             }
35              
36             sub escape {
37 5768     5768 0 10155 my ($class, $value) = @_;
38 5768         11439 $value =~ s!~!~0!g;
39 5768         8592 $value =~ s!/!~1!g;
40 5768         15828 return $value;
41             }
42              
43             sub unescape {
44 373     373 0 688 my ($class, $value) = @_;
45 373         701 $value =~ s!~1!/!g;
46 373         568 $value =~ s!~0!~!g;
47 373         951 return $value;
48             }
49              
50             sub new {
51 1013     1013 0 2871 my ($class, %params) = @_;
52              
53 1013         2327 my ($scope, $value, $validator) = @params{qw/scope value validator/};
54              
55 1013 50       2008 croak 'JSONPointer: scope is required' unless defined $scope;
56 1013 50       1859 croak 'JSONPointer: validator is required' unless $validator;
57              
58 1013         2565 weaken($validator);
59              
60 1013         2751 my $self = {
61             scope => $scope,
62             value => $value,
63             validator => $validator
64             };
65              
66 1013         1822 bless $self, $class;
67              
68 1013         3671 return $self;
69             }
70              
71 2845     2845 0 6532 sub validator { shift->{validator} }
72 1046     1046 0 2348 sub scope { shift->{scope} }
73 2348     2348 0 5051 sub value { shift->{value} }
74              
75             sub xget {
76 829     829 0 1725 my ($self, @parts) = @_;
77              
78 829         1523 my $current_scope = $self->scope;
79 829         1483 my $current_value = $self->value;
80              
81 829   66     3303 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 829 100 100     2073 if (ref $current_value eq 'HASH' && $self->validator->using_id_with_ref) {
88 114         316 my $id = $current_value->{$self->validator->ID_FIELD};
89 114 100 66     498 if ($id && !ref $id) {
90 89 50       312 $current_scope = $current_scope
91             ? URI->new($id)->abs($current_scope)->as_string
92             : $id;
93             }
94             }
95              
96 829         9370 for my $part (@parts) {
97 1082 100 100     4815 if (ref $current_value eq 'HASH' && exists $current_value->{$part}) {
    100 66        
      66        
98 852         1626 $current_value = $current_value->{$part};
99             } elsif (ref $current_value eq 'ARRAY' && $part =~ m/^\d+$/ && scalar(@$current_value) > $part) {
100 61         127 $current_value = $current_value->[$part];
101             } else {
102 169         304 $current_value = undef;
103 169         275 last;
104             }
105              
106 913   100     2999 while (ref $current_value eq 'HASH' && $current_value->{'$ref'}) {
107 34         123 my $ref = URI->new($current_value->{'$ref'});
108 34 100       1627 $ref = $ref->abs($current_scope) if $current_scope;
109 34         549 ($current_scope, $current_value) = $self->validator->resolver->resolve($ref);
110             }
111              
112 913 100 100     2488 if (ref $current_value eq 'HASH' && $self->validator->using_id_with_ref) {
113 230         446 my $id = $current_value->{$self->validator->ID_FIELD};
114 230 100 66     738 if ($id && !ref $id) {
115 2 50       8 $current_scope = $current_scope
116             ? URI->new($id)->abs($current_scope)->as_string
117             : $id;
118             }
119             }
120             }
121              
122 829         1614 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 203     203 0 496 my ($self, $pointer) = @_;
132 203 50       533 return $self unless $pointer;
133              
134 203 50       1223 croak "Invalid JSON Pointer $pointer" unless $pointer =~ s!^/!!;
135              
136             my @parts = length $pointer
137 203 100       1217 ? map { $self->unescape($_) } split(/\//, $pointer, -1)
  373         811  
138             : ('');
139              
140 203         613 return $self->xget(@parts);
141             }
142              
143             sub keys {
144 51     51 0 114 my ($self, %params) = @_;
145 51   100     156 my $raw = $params{raw} // 0;
146              
147 51 100       100 if (ref $self->value eq 'HASH') {
148 26 50       42 return map { $raw ? $_ : $self->join($_) } keys %{$self->value};
  33         147  
  26         43  
149             }
150              
151 25 50       49 if (ref $self->value eq 'ARRAY') {
152 25 50       43 return map { $raw ? $_ : $self->join($_) } 0 .. $#{$self->value};
  61         139  
  25         58  
153             }
154              
155 0           return;
156             }
157              
158             1;
159              
160             __END__