JSON-Structure

 view release on metacpan or  search on metacpan

lib/JSON/Structure/InstanceValidator.pm  view on Meta::CPAN

}

sub _resolve_ref {
    my ( $self, $ref, $root ) = @_;

    # Handle # prefix
    $ref =~ s/^#//;

    return $root if $ref eq '' || $ref eq '/';

    my @segments = split m{/}, $ref;
    shift @segments if @segments && $segments[0] eq '';

    my $current = $root;

    for my $segment (@segments) {

        # Unescape JSON Pointer tokens
        $segment =~ s/~1/\//g;
        $segment =~ s/~0/~/g;

lib/JSON/Structure/JsonSourceLocator.pm  view on Meta::CPAN

    my ( $self, $path ) = @_;

    # Remove leading # if present (JSON Pointer fragment identifier)
    $path =~ s/^#//;

    # Handle empty path or just "/"
    return () if !defined $path || $path eq '' || $path eq '/';

    my @segments;

    for my $segment ( split m{/}, $path ) {
        next if $segment eq '';

        # Unescape JSON Pointer tokens
        $segment =~ s/~1/\//g;
        $segment =~ s/~0/~/g;

        # Handle bracket notation (e.g., "required[0]" -> "required", "0")
        if ( $segment =~ /^([^\[]+)\[(.+)\]$/ ) {
            push @segments, $1;
            my $rest = "[$2]";

lib/JSON/Structure/SchemaValidator.pm  view on Meta::CPAN

}

sub _resolve_json_pointer {
    my ( $self, $pointer, $doc ) = @_;

    # Handle # prefix
    $pointer =~ s/^#//;

    return $doc if $pointer eq '' || $pointer eq '/';

    my @segments = split m{/}, $pointer;
    shift @segments if @segments && $segments[0] eq '';

    my $current = $doc;

    for my $segment (@segments) {

        # Unescape JSON Pointer tokens
        $segment =~ s/~1/\//g;
        $segment =~ s/~0/~/g;

t/04_test_assets.t  view on Meta::CPAN

    close($fh);
    
    return $json->decode($content);
}

sub resolve_json_pointer {
    my ($pointer, $doc) = @_;
    
    return undef unless $pointer =~ m{^/};
    
    my @parts = split m{/}, substr($pointer, 1);
    my $current = $doc;
    
    for my $part (@parts) {
        # Handle JSON pointer escaping
        $part =~ s/~1/\//g;
        $part =~ s/~0/~/g;
        
        if (ref($current) eq 'HASH') {
            return undef unless exists $current->{$part};
            $current = $current->{$part};