view release on metacpan or  search on metacpan

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

                $match_count++;
            }
        }

        $self->{errors} = $temp_errors;

        if ( $match_count != 1 ) {
            $self->_add_error(
                INSTANCE_ONE_OF_INVALID_COUNT,
"Value must match exactly one schema in oneOf (matched $match_count)",
                $path,
                $schema_path
            );
        }
    }

    # not
    if ( exists $schema->{not} ) {
        my $temp_errors = $self->{errors};
        $self->{errors} = [];
        $self->_validate_value( $value, $schema->{not}, $path,
            "$schema_path/not" );
        my $matched = @{ $self->{errors} } == 0;
        $self->{errors} = $temp_errors;

        if ($matched) {
            $self->_add_error( INSTANCE_NOT_MATCHED,
                "Value must not match the schema in 'not'",
                $path, $schema_path );
        }
    }

    # if/then/else
    if ( exists $schema->{if} ) {
        my $temp_errors = $self->{errors};
        $self->{errors} = [];
        $self->_validate_value( $value, $schema->{if}, $path,
            "$schema_path/if" );
        my $if_matched = @{ $self->{errors} } == 0;
        $self->{errors} = $temp_errors;

        if ( $if_matched && exists $schema->{then} ) {
            $self->_validate_value( $value, $schema->{then}, $path,
                "$schema_path/then" );
        }
        elsif ( !$if_matched && exists $schema->{else} ) {
            $self->_validate_value( $value, $schema->{else}, $path,
                "$schema_path/else" );
        }
    }
}

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;

        if ( ref($current) eq 'HASH' ) {
            return undef unless exists $current->{$segment};
            $current = $current->{$segment};
        }
        elsif ( ref($current) eq 'ARRAY' ) {
            return undef unless $segment =~ /^\d+$/;
            my $idx = int($segment);
            return undef if $idx >= @$current;
            $current = $current->[$idx];
        }
        else {
            return undef;
        }
    }

    return $current;
}

sub _values_equal {
    my ( $self, $a, $b ) = @_;

    # Handle undefined
    if ( !defined $a && !defined $b ) {
        return 1;
    }
    if ( !defined $a || !defined $b ) {
        return 0;
    }

    # Handle different types
    my $ref_a = ref($a);
    my $ref_b = ref($b);

    if ( $ref_a ne $ref_b ) {
        return 0;
    }

    if ( $ref_a eq '' ) {

        # Scalars
        return $a eq $b;
    }
    elsif ( $ref_a eq 'ARRAY' ) {
        return 0 if @$a != @$b;
        for my $i ( 0 .. $#$a ) {
            return 0 unless $self->_values_equal( $a->[$i], $b->[$i] );
        }
        return 1;
    }
    elsif ( $ref_a eq 'HASH' ) {