Skip to content

Instantly share code, notes, and snippets.

@dolmen
Created Feb 9, 2017
Embed
What would you like to do?
JSON Pointer in Perl 5
# Copyright (c) 2017 Olivier Mengué
# JSON Pointer: https://tools.ietf.org/html/rfc6901
sub json_pointer_get ($$)
{
my ($doc, $ptr) = @_;
return $doc unless length $ptr;
substr($ptr, 0, 1, '') eq '/' or croak "invalid pointer (syntax): $ptr";
my @paths =
($ptr eq '' ? $ptr : split m!/!, $ptr, -1);
while (@paths) {
my $r = ref $doc;
my $p = shift @paths;
croak "invalid pointer (no object/array for '$p'): $_[1]" unless $r;
if ($r eq 'HASH') {
# https://tools.ietf.org/html/rfc6901#section-3
croak "invalid pointer (syntax): $_[1]" if $p =~ /~[^01]/;
$p =~ s!~1!/!g; $p =~ s!~0!~!g;
croak "invalid pointer (missing property '$p'): $_[1]" unless exists $doc->{$p};
$doc = $doc->{$p}
} elsif ($r eq 'ARRAY' && $p =~ m{\A(?:0|[1-9][0-9]*)\z}) {
croak "invalid pointer (missing index $p): $_[1]" unless $p <= $#$doc;
$doc = $doc->[$p]
} else {
croak "invalid pointer (no object/array for '$p'): $_[1]"
}
}
$doc
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment