File Coverage

blib/lib/JSON/Pointer/Syntax.pm
Criterion Covered Total %
statement 40 40 100.0
branch 8 8 100.0
condition 3 3 100.0
subroutine 11 11 100.0
pod 5 5 100.0
total 67 67 100.0


line stmt bran cond sub pod time code
1             package JSON::Pointer::Syntax;
2              
3 16     16   141248 use 5.008_001;
  16         56  
  16         763  
4 16     16   84 use strict;
  16         30  
  16         464  
5 16     16   78 use warnings;
  16         43  
  16         462  
6              
7 16     16   233 use Exporter qw(import);
  16         36  
  16         497  
8 16     16   3034 use JSON::Pointer::Context;
  16         80  
  16         391  
9 16     16   2734 use JSON::Pointer::Exception qw(:all);
  16         32  
  16         11455  
10              
11             our $VERSION = '0.06';
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 15     15 1 1497 my $unescaped_reference_token = shift;
25              
26 15         32 $unescaped_reference_token =~ s/~/~0/g;
27 15         21 $unescaped_reference_token =~ s/\x2F/~1/g;
28              
29 15         61 return $unescaped_reference_token;
30             }
31              
32             sub unescape_reference_token {
33 204     204 1 1829 my $escaped_reference_token = shift;
34              
35 204         298 $escaped_reference_token =~ s/~1/\x2F/g;
36 204         273 $escaped_reference_token =~ s/~0/~/g;
37              
38 204         1165 return $escaped_reference_token;
39             }
40              
41             sub tokenize {
42 156     156 1 12558 my ($class, $pointer) = @_;
43 156         178 my @tokens;
44              
45 156         182 my $orig_pointer = $pointer;
46              
47 156         1784 while ($pointer =~ s{/($REGEX_REFERENCE_TOKEN)}{}) {
48 201         444 my $token = $1;
49 201         362 push @tokens => unescape_reference_token($token);
50             }
51              
52 156 100 100     742 unless ($orig_pointer eq "" || $pointer eq "") {
53 3         12 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 153 100       800 return wantarray ? @tokens : [ @tokens ];
62             }
63              
64             sub as_pointer {
65 12     12 1 7276 my ($class, $tokens) = @_;
66              
67 12         23 return @$tokens > 0 ? "/" . join(
68             "/",
69 12 100       39 map { escape_reference_token($_) }
70             @$tokens
71             ) : "";
72              
73             }
74              
75             sub is_array_numeric_index {
76 59     59 1 3362 my $token = shift;
77 59 100       903 return $token =~ m/^$REGEX_ARRAY_INDEX$/ ? 1 : 0;
78             }
79              
80             1;
81              
82             __END__