view release on metacpan or  search on metacpan

scripts/jsonvalidate  view on Meta::CPAN

        # No LWP or fetch failed; return undef so caller can try alternatives or die.
        return;
    };
}

sub _first_existing_path
{
    for my $p ( @_ )
    {
        return( $p ) if( defined( $p ) && $p->exists );
    }
    return;
}

# Get the JSON data from STDIN
sub _get_stdin
{
    $out->print( "Enter the JSON data below and type ctrl-D when finished:\n" ) if( &_is_tty );
    my $json = '';
    $json .= $_ while( <STDIN> );
    $json =~ s/(\r?\n)+$//gs;
    _message( 4, "JSON received is '$json'" );
    return( $json );
}

# Taken from ExtUtils::MakeMaker
sub _is_tty
{
    return( -t( STDIN ) && ( -t( STDOUT ) || !( -f STDOUT || -c STDOUT ) ) );
}

sub _message
{
    my $required_level;
    if( $_[0] =~ /^\d{1,2}$/ )
    {
        $required_level = shift( @_ );
    }
    else
    {
        $required_level = 0;
    }
    return if( !$LOG_LEVEL || $LOG_LEVEL < $required_level );
    my $msg = join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @_ ) );
    if( index( $msg, '</>' ) != -1 )
    {
        $msg =~ s
        {
            <([^\>]+)>(.*?)<\/>
        }
        {
            my $colour = $1;
            my $txt = $2;
            my $obj = color( $txt );
            my $code = $obj->can( $colour ) ||
                die( "Colour '$colour' is unsupported by Term::ANSIColor::Simple" );
            $code->( $obj );
        }gexs;
    }
    my $frame = 0;
    my $sub_pack = (caller(1))[3] || '';
    my( $pkg, $file, $line ) = caller( $frame );
    my $sub = ( caller( $frame + 1 ) )[3] // '';
    my $sub2;
    if( length( $sub ) )
    {
        $sub2 = substr( $sub, rindex( $sub, '::' ) + 2 );
    }
    else
    {
        $sub2 = 'main';
    }
    return( $err->print( "${pkg}::${sub2}() [$line]: $msg\n" ) );
}

sub _run_data_maybe_array
{
    my( $js, $data, $ok_ref, $fail_ref, $idx_ref, $json ) = @_;

    if( ref( $data ) eq 'ARRAY' )
    {
        for my $elem ( @$data )
        {
            _run_one( $js, $elem, $ok_ref, $fail_ref, ++$$idx_ref, $json );
        }
    }
    else
    {
        _run_one( $js, $data, $ok_ref, $fail_ref, ++$$idx_ref, $json );
    }
}

sub _run_one
{
    my( $js, $data, $ok_ref, $fail_ref, $idx, $json ) = @_;

    my $ok = $js->validate( $data );

    if( $opts->{json} )
    {
        if( $ok )
        {
            $out->print( $json->encode({ index => $idx, ok => JSON::true }), "\n" );
        }
        else
        {
            my @errs = map
            {
                {
                    path       => $_->path,
                    message    => $_->message,
                    keyword    => $_->keyword,
                    schema_ptr => $_->schema_pointer,
                }
            } @{$js->errors || []};

            $out->print( $json->encode({
                index => $idx,
                ok    => JSON::false,
                errors => \@errs,
            }), "\n" );
        }
    }