view release on metacpan or  search on metacpan

scripts/jsonvalidate  view on Meta::CPAN

        my $source = join( ', ', map{ $_->basename } @{$opts->{schema}} );
        require DateTime;
        my $now    = DateTime->now->iso8601;
        $out->print( <<HEADER );
// =============================================================================
// JSON Schema Validator — Client-Side (Compiled from Perl)
// =============================================================================
// Schema   : $source
// Generated: $now
// Validator: JSON::Schema::Validate $JSON::Schema::Validate::VERSION (Perl)
// Module   : $INC{'JSON/Schema/Validate.pm'}
// Compiler : jsonvalidate --emit-js
// =============================================================================

HEADER
        $out->print( $js_code );
        return( $total_fail ? 0 : 1 );
    }
    # Summary & exit code
    elsif( !$opts->{quiet} && !$opts->{json} )
    {
        $out->print( "Summary: OK=$total_ok  FAIL=$total_fail\n" );
    }
    # Return 0 on failure, and 1 on success
    _message( 5, "<red>$total_fail</> total fail. Returning ", ( $total_fail ? 0 : 1 ) );
    return( $total_fail ? 0 : 1 );
}

sub _cleanup_and_exit
{
    my $exit = shift( @_ );
    $exit = 0 if( !length( $exit // '' ) || $exit !~ /^\d+$/ );
    exit( $exit );
}

sub _decode_json_or_die
{
    my( $raw, $json, $label ) = @_;
    my $data;
    local $@;
    eval
    {
        $data = $json->decode( $raw );
        1;
    }
    or do
    {
        bailout( "Failed to decode JSON ($label): $@" );
    };
    return( $data );
}

sub _fetch_http_json
{
    my( $url, $json ) = @_;

    local $@;
    eval
    {
        require LWP::UserAgent;
        require HTTP::Request;
        my $ua = LWP::UserAgent->new( timeout => 10 );
        my $res = $ua->get( $url );
        if( $res->is_success )
        {
            return( _decode_json_or_die( $res->decoded_content, $json, "$url: " ) );
        }
        bailout( "HTTP $url failed: " . $res->status_line );
    }
    or do
    {
        # 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
        {
            <([^\>]+)>(.*?)<\/>
        }