view release on metacpan or  search on metacpan

t/04_test_assets.t  view on Meta::CPAN

my $SAMPLES_ROOT = File::Spec->catdir($SDK_ROOT, 'primer-and-samples', 'samples', 'core');

# Check if test-assets exists
unless (-d $TEST_ASSETS) {
    plan skip_all => "test-assets directory not found at $TEST_ASSETS";
}

=head2 Helper Functions

=cut

sub get_schema_files {
    my ($dir) = @_;
    return () unless -d $dir;
    
    opendir(my $dh, $dir) or return ();
    my @files = grep { /\.struct\.json$/ && -f File::Spec->catfile($dir, $_) } readdir($dh);
    closedir($dh);
    
    return map { File::Spec->catfile($dir, $_) } sort @files;
}

sub get_instance_dirs {
    my ($dir) = @_;
    return () unless -d $dir;
    
    opendir(my $dh, $dir) or return ();
    my @dirs = grep { !/^\./ && -d File::Spec->catfile($dir, $_) } readdir($dh);
    closedir($dh);
    
    return map { File::Spec->catfile($dir, $_) } sort @dirs;
}

sub get_json_files {
    my ($dir) = @_;
    return () unless -d $dir;
    
    opendir(my $dh, $dir) or return ();
    my @files = grep { /\.json$/ && -f File::Spec->catfile($dir, $_) } readdir($dh);
    closedir($dh);
    
    return map { File::Spec->catfile($dir, $_) } sort @files;
}

sub load_json_file {
    my ($path) = @_;
    
    open(my $fh, '<:encoding(UTF-8)', $path) or die "Cannot open $path: $!";
    local $/;
    my $content = <$fh>;
    close($fh);
    
    return $json->decode($content);
}

sub resolve_json_pointer {
    my ($pointer, $doc) = @_;
    
    return undef unless $pointer =~ m{^/};
    
    my @parts = split m{/}, substr($pointer, 1);
    my $current = $doc;
    
    for my $part (@parts) {
        # Handle JSON pointer escaping
        $part =~ s/~1/\//g;
        $part =~ s/~0/~/g;
        
        if (ref($current) eq 'HASH') {
            return undef unless exists $current->{$part};
            $current = $current->{$part};
        }
        elsif (ref($current) eq 'ARRAY') {
            return undef unless $part =~ /^\d+$/;
            my $index = int($part);
            return undef if $index < 0 || $index >= @$current;
            $current = $current->[$index];
        }
        else {
            return undef;
        }
    }
    
    return $current;
}

sub basename {
    my ($path) = @_;
    my (undef, undef, $file) = File::Spec->splitpath($path);
    return $file;
}

sub dirname {
    my ($path) = @_;
    my ($vol, $dir, undef) = File::Spec->splitpath($path);
    return File::Spec->catpath($vol, $dir, '');
}

=head2 Invalid Schema Tests

Test that all invalid schemas in test-assets/schemas/invalid fail validation.

=cut

subtest 'Invalid schemas should fail validation' => sub {
    my @schema_files = get_schema_files($INVALID_SCHEMAS);
    
    if (!@schema_files) {
        plan skip_all => "No invalid schema files found in $INVALID_SCHEMAS";
        return;
    }
    
    plan tests => scalar(@schema_files);
    
    my $validator = JSON::Structure::SchemaValidator->new(extended => 1);
    
    for my $schema_file (@schema_files) {
        my $filename = basename($schema_file);
        
        my $schema = eval { load_json_file($schema_file) };
        if ($@) {