JSON Pointer in Perl 5

jsonptr.pl

# 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
}