view release on metacpan or  search on metacpan

lib/Net/API/CPAN/Mock.pm  view on Meta::CPAN

            bind( $s, $addr ) || next;
            listen( $s, 10 ) || return( $self->error( "Unable to listen on host $host with port $port: $!" ) );
            last;
        }
        $self->host( $host );
        $self->port( $port );
        $self->socket( $s );
    }
    return( $self );
}

sub checksum { return( shift->_set_get_scalar( 'checksum', @_ ) ); }

sub data { return( $TEST_DATA ); }

sub endpoints { return( shift->_set_get_hash_as_mix_object( 'endpoints', @_ ) ); }

sub host
{
    my $self = shift( @_ );
    if( @_ )
    {
        $self->{host} = shift( @_ );
    }
    else
    {
        $self->bind || return( $self->pass_error );
    }
    return( $self->{host} );
}

sub json { return( shift->_set_get_object( 'json', 'JSON', @_ ) ); }

sub load_specs
{
    my $self = shift( @_ );
    my $file = shift( @_ ) || return( $self->error( "No openapi specifications file was provided." ) );
    $file = $self->new_file( $file );
    if( !$file->exists )
    {
        return( $self->error( "OpenAPI specifications file provided $file does not exist." ) );
    }
    elsif( !$file->is_file )
    {
        return( $self->error( "OpenAPI specifications file provided $file is not a regular file." ) );
    }
    elsif( $file->is_empty )
    {
        return( $self->error( "OpenAPI specifications file provided $file is empty." ) );
    }
    my $checksum = $file->checksum_md5;
    if( $self->{checksum} &&
        $self->{checksum} eq $checksum &&
        $self->{specs} &&
        ref( $self->{specs} ) eq 'HASH' &&
        scalar( keys( %{$self->{specs}} ) ) )
    {
        warn( "Called to reprocess the OpenAPI specification, but we already have a cache, so re-using the cache instead.\n" ) if( $self->_is_warnings_enabled );
        return( $self );
    }
    my $specs = $file->load_json( boolean_values => [0,1] ) || return( $self->pass_error( $file->error ) );
    my $paths = $specs->{paths} || return( $self->error( "No 'paths' property found in the openapi specifications provided." ) );
    return( $self->error( "The 'paths' property found is not an hash reference." ) ) if( !defined( $paths ) || ref( $paths ) ne 'HASH' );
    $self->{specs} = $specs;
    $self->{checksum} = $file->checksum_md5;
    my $def = {};
    
    my $seen = {};
    my $processed = {};

    # NOTE: resolve_ref()
    my $resolve_ref = sub
    {
        my $schema = shift( @_ );
        my $opts = $self->_get_args_as_hash( @_ );
        my $ctx = $opts->{context};
        # Already processed previously
        if( ref( $schema ) eq 'HASH' &&
            exists( $processed->{ $self->_refaddr( $schema ) } ) )
        {
            return( $schema );
        }
    
        return( $self->error( "Found a schema reference (\$ref) for path $ctx->{path} and method $ctx->{method}, but its value is not a plain string (", overload::StrVal( $schema ), ")" ) ) if( ref( $schema ) );
        # This is valid, but unsupported by us.
        # <https://spec.openapis.org/oas/v3.0.0#reference-object>
        # <https://spec.openapis.org/oas/v3.0.0#example-object-example>
        if( lc( substr( $schema, 0, 4 ) // '' ) eq 'http' )
        {
            return( $self->error( "External http schema reference is not supported by this tool for path $ctx->{path} and method $ctx->{method}" ) );
        }
        return( $self->error( "Schema reference set for path $ctx->{path} and method $ctx->{method} should start with '#/', but it does not ($schema)." ) ) unless( substr( $schema, 0, 2 ) eq '#/' );
        # Prevent infinite recursion
        if( exists( $seen->{ $schema } ) )
        {
            return( $seen->{ $schema } );
        }
        $schema = substr( $schema, 2 );
        my $frags = [split( /\//, $schema )];
        scalar( @$frags ) || 
            return( $self->error( "The schema reference for path $ctx->{path} and method $ctx->{method} does not have any schema value." ) );
        $self->message( 4, "Checking the path fragments '", join( "', '", @$frags ), "'" );
        my $tmp = $specs;
        my $breadcrumbs = ['/'];
        for( my $i = 0; $i < scalar( @$frags ); $i++ )
        {
            $self->message( 4, "Checking path fragment '", $frags->[$i], "'" );
            if( exists( $tmp->{ $frags->[$i] } ) )
            {
                $tmp = $tmp->{ $frags->[$i] };
                push( @$breadcrumbs, $frags->[$i] );
            }
            else
            {
                return( $self->error( "Unable to find path fragment '", $frags->[$i], "' in OpenAPI specifications in ", join( '/', @$breadcrumbs ), " for path $ctx->{path} and method $ctx->{method}" ) );
            }
        }
        $seen->{ $schema } = $tmp;
        $processed->{ $self->_refaddr( $tmp ) } = $tmp;
        return( $tmp );
    };