view release on metacpan or  search on metacpan

scripts/jsonvalidate  view on Meta::CPAN

    {
        _message( 5, "No <green>schema_base</> value provided, deriving it from <green>$root_schema_path</>" );
        # Set 'schema_base' to the parent directory of the first schema file found.
        $opts->{schema_base} = $root_schema_path->parent;
        _message( 5, "<green>schema_base</> is now set to <green>$opts->{schema_base}</>" );
    }

     if( $opts->{extensions} )
     {
        $opts->{unique_keys} = $opts->{extensions};
     }   

    # Build the validator from the FIRST schema (root)
    my %ctor =
    (
        compile                         => $opts->{compile} ? 1 : 0,
        content_assert                  => $opts->{content_checks} ? 1 : 0,
        extensions                      => $opts->{extensions} ? 1 : 0,
        ignore_unknown_required_vocab   => $opts->{ignore_vocab} ? 1 : 0,
        max_errors                      => $opts->{max_errors},
        normalize_instance              => $opts->{normalize} ? 1 : 0,
        trace                           => $opts->{trace} ? 1 : 0,
        trace_limit                     => $opts->{trace_limit},
        trace_sample                    => $opts->{trace_sample},
        unique_keys                     => $opts->{unique_keys} ? 1 : 0,
    );
    local $JSON::Schema::Validate::DEBUG = $opts->{debug};
    my $js = JSON::Schema::Validate->new( $schemas[0], %ctor );
    # Register built-in formats if desired
    if( $opts->{register_formats} )
    {
        _message( 5, "Registering builtin formats." );
        $js->register_builtin_formats;
    }

    # Content checks on?
    if( $opts->{content_checks} )
    {
        _message( 5, "Asserting content." );
        $js->content_checks(1);
    }

    # Simple resolver:
    # - file:/… or relative paths from --schema-base
    # - http(s):// if LWP::UserAgent is available (optional)
    # - otherwise: if the requested absolute matches any secondary schema $id, return it
    my %by_id;
    for my $s ( @schemas )
    {
        if( ref( $s ) eq 'HASH' && defined( $s->{'$id'} ) )
        {
            $by_id{ $s->{'$id'} } = $s;
        }
    }

    $js->set_resolver(sub
    {
        my( $abs_uri ) = @_;
        my $orig_uri = $abs_uri;

        # Strip fragment for all decisions below
        my( $doc_uri, $fragment ) = ( $abs_uri =~ /^([^#]+)(#.*)?$/ );
        $doc_uri //= $abs_uri;
        my $has_fragment = defined( $fragment ) && length( $fragment );

        # First: exact $id match from any schema we were given on the command line
        if( exists( $by_id{ $abs_uri } ) || exists( $by_id{ $doc_uri } ) )
        {
            my $schema = $by_id{ $abs_uri } // $by_id{ $doc_uri };
            _message( 6, "Resolver: found pre-loaded schema for ", $by_id{ $abs_uri } ? $abs_uri : $doc_uri );
            return( $schema );
        }

        # Optional: allow relative/local file refs (very common and safe)
        if( $opts->{allow_file_refs} && defined( $opts->{schema_base} ) )
        {
            # If it's not a proper scheme, treat as relative path
            if( $doc_uri !~ /^[a-zA-Z][a-zA-Z0-9+.-]*:/ )
            {
                my $path = file( $doc_uri, base_dir => $opts->{schema_base} );
                if( $path->exists )
                {
                    _message( 6, "Resolver: loading local file $path for $doc_uri" );
                    return( $path->load_json );
                }
            }
            # Also support explicit file:// URIs
            elsif( $doc_uri =~ m{^file://}i )
            {
                my $path = file( $doc_uri );
                if( $path->exists )
                {
                    _message( 6, "Resolver: loading file:// URI $path" );
                    return( $path->load_json );
                }
            }
        }

        # Only if user explicitly asked for remote fetching
        #    Can also be called as --allow_http. It is aliased to --remote_refs
        if( $doc_uri =~ m{^https?://}i )
        {
            # The specs say that, if there is a fragment, we should always fetch the remote document.
            my $should_fetch = $has_fragment || $opts->{remote_refs};
            if( $should_fetch )
            {
                _message( 5, "Resolver: fetching remote document $doc_uri (fragment=$has_fragment, remote-refs=", ( $opts->{remote_refs} // 0 ), ")" );
                my $doc = _fetch_http_json( $doc_uri, $json );
                return( $doc ) if( defined( $doc ) );
            }
            else
            {
                _message( 4, "Resolver: refusing to fetch remote $doc_uri (no fragment and --remote-refs not used)" );
                return;
            }
        }

        my $path = file( $doc_uri );
        # 4. Last resort: maybe it's a bare filename without base?
        if( $path->exists && $path->is_file )
        {
            _message( 6, "Resolver: fallback loading bare path $path" );
            return( $path->load_json );
        }

        # Fail loudly with helpful message
        bailout( <<EOF );
    Cannot resolve \$ref "$orig_uri"

    Document URI: $doc_uri
    Fragment    : $fragment

    This is probably a fictional/internal \$id (very common and correct!).

    The validator will NOT auto-fetch such URIs by default (security + correctness).

    This looks like a reference to a remote document with a JSON Pointer fragment.
    Such references MUST be retrieved (per JSON Schema spec).

    Solutions:
      • Pass --remote-refs to allow HTTP(S) fetching
      • Provide the referenced schema via additional --schema arguments
      • Rewrite the schema to use relative references + --schema-base
EOF
    });

    # Optional: capture $comment into trace (no-op handler by default)
    $js->set_comment_handler(sub{});

    # Validate instances
    my $total_ok   = 0;
    my $total_fail = 0;
    my $run_idx    = 0;

    if( $opts->{instance}->is_empty )
    {
        if( $opts->{jsonl} )
        {
            _message( 5, "No JSON data file was provided, reading from STDIN line by line." );
            while( defined( my $line = <STDIN> ) )
            {
                next if $line =~ /\A\s*\z/;
                my $data = _decode_json_or_die( $line, $json, "STDIN: line $.: " );
                _run_one( $js, $data, \$total_ok, \$total_fail, ++$run_idx, $json );
            }
        }
        else
        {
            _message( 5, "No JSON data file was provided, reading from STDIN all in one go." );
            my $data = &_get_stdin();
            _run_one( $js, $data, \$total_ok, \$total_fail, ++$run_idx, $json );
        }
    }
    else
    {
        for my $inst_file ( @{$opts->{instance}} )
        {
            _message( 5, "Processing JSON data file <green>$inst_file</>" );
            if( !$inst_file->exists )
            {
                bailout( "The instance file \"$inst_file\" does not exist." );
            }
            elsif( $inst_file->is_empty )
            {
                _message( 1, "The instance file \"$inst_file\" is empty." );
                next;
            }
            my $raw = $inst_file->load( binmode => 'raw' );
            if( !defined( $raw ) )
            {
                _message( 1, "The instance file \"$inst_file\" content could not be retrieved: ", $inst_file->error );
                next;
            }
    
            if( $opts->{jsonl} )
            {
                _message( 5, "Processing the file <green>$inst_file</> data line-by-line." );