File Coverage

blib/lib/JSON/Pointer/Syntax.pm
Criterion Covered Total %
statement 41 41 100.0
branch 10 10 100.0
condition 3 3 100.0
subroutine 11 11 100.0
pod 5 5 100.0
total 70 70 100.0


line stmt bran cond sub pod time code
1             package JSON::Pointer::Syntax;
2              
3 17     17   81518 use 5.008_001;
  17         41  
4 17     17   63 use strict;
  17         20  
  17         323  
5 17     17   55 use warnings;
  17         18  
  17         415  
6              
7 17     17   59 use Exporter qw(import);
  17         21  
  17         484  
8 17     17   1825 use JSON::Pointer::Context;
  17         55  
  17         1193  
9 17     17   1827 use JSON::Pointer::Exception qw(:all);
  17         21  
  17         9402  
10              
11             our $VERSION = '0.07';
12             our @EXPORT_OK = qw(
13             escape_reference_token
14             unescape_reference_token
15             is_array_numeric_index
16             );
17              
18             our $REGEX_ESCAPED = qr{~[01]};
19             our $REGEX_UNESCAPED = qr{[\x{00}-\x{2E}\x{30}-\x{7D}\x{7F}-\x{10FFFF}]};
20             our $REGEX_REFERENCE_TOKEN = qr{(?:$REGEX_ESCAPED|$REGEX_UNESCAPED)*};
21             our $REGEX_ARRAY_INDEX = qr{(?:0|[1-9][0-9]*)};
22              
23             sub escape_reference_token {
24 33     33 1 809 my $unescaped_reference_token = shift;
25              
26 33         58 $unescaped_reference_token =~ s/~/~0/g;
27 33         41 $unescaped_reference_token =~ s/\x2F/~1/g;
28              
29 33         118 return $unescaped_reference_token;
30             }
31              
32             sub unescape_reference_token {
33 243     243 1 980 my $escaped_reference_token = shift;
34              
35 243         294 $escaped_reference_token =~ s/~1/\x2F/g;
36 243         231 $escaped_reference_token =~ s/~0/~/g;
37              
38 243         1134 return $escaped_reference_token;
39             }
40              
41             sub tokenize {
42 178     178 1 7442 my ($class, $pointer) = @_;
43 178         176 my @tokens;
44              
45 178         168 my $orig_pointer = $pointer;
46              
47 178         1924 while ($pointer =~ s{/($REGEX_REFERENCE_TOKEN)}{}) {
48 240         437 my $token = $1;
49 240         358 push @tokens => unescape_reference_token($token);
50             }
51              
52 178 100 100     741 unless ($orig_pointer eq "" || $pointer eq "") {
53 3         9 JSON::Pointer::Exception->throw(
54             code => ERROR_INVALID_POINTER_SYNTAX,
55             context => JSON::Pointer::Context->new(
56             pointer => $orig_pointer,
57             ),
58             );
59             }
60              
61 175 100       678 return wantarray ? @tokens : [ @tokens ];
62             }
63              
64             sub as_pointer {
65 30     30 1 21389 my $class = shift;
66 30 100       87 my @tokens = (ref $_[0] eq "ARRAY") ? @{$_[0]} : @_;
  12         25  
67              
68             return @tokens > 0 ? "/" . join(
69             "/",
70 30 100       75 map { escape_reference_token($_) }
  30         47  
71             @tokens
72             ) : "";
73             }
74              
75             sub is_array_numeric_index {
76 62     62 1 4681 my $token = shift;
77 62 100       861 return $token =~ m/^$REGEX_ARRAY_INDEX$/ ? 1 : 0;
78             }
79              
80             1;
81              
82             __END__