view release on metacpan or  search on metacpan

lib/Test/Attean/W3CManifestTestSuite.pm  view on Meta::CPAN

# # 	if ($self->debug) {
# # 		my $q			= $content;
# # 		$q				=~ s/\s+/ /g;
# # 		warn "### test     : " . $test->as_string . "\n";
# # 		warn "# file       : $filename\n";
# # 		warn "# content    : $q\n";
# # 	}
# 	
# 	if ($is_pos_ttl or $is_neg_ttl or $is_eval_ttl) {
# 		my $test_base	= $uri->as_string;
# 		$test_base		=~ s{^.*/rdf-tests/}{https://w3c.github.io/rdf-tests/}; # XXX hack
# 		
# 		my $ttl_parser	= Attean->get_parser('Turtle')->new(base => $test_base);
# 		my $nt_parser	= Attean->get_parser('NTriples')->new();
# 		if ($is_pos_ttl or $is_eval_ttl) {
# 			my (@triples)	= eval { $ttl_parser->parse_list_from_bytes($bytes) };
# 			my $ok	= scalar(@triples);
# 			$self->record_result('syntax', $ok, $test->as_string);
# 			if ($ok) {
# 				pass("$testname - $filename");
# 			} else {
# 				fail("$testname - $filename: $@");
# 			}
# 		} elsif ($is_pos_nt or $is_eval_nt) {
# 			my (@triples)	= eval { $nt_parser->parse_list_from_bytes($bytes) };
# 			my $ok	= scalar(@triples);
# 			$self->record_result('syntax', $ok, $test->as_string);
# 			if ($ok) {
# 				pass("$testname - $filename");
# 			} else {
# 				fail("$testname - $filename: $@");
# 			}
# 		} elsif ($is_neg_ttl) {
# 			my (@triples)	= eval { $ttl_parser->parse_list_from_bytes($bytes) };
# 			my $ok	= $@ ? 1 : 0;
# 			$self->record_result('syntax', $ok, $test->as_string);
# 			if ($ok) {
# 				pass("$testname - $filename");
# 			} else {
# # 				if ($self->debug) {
# # 					warn $query->as_string;
# # 				}
# 				fail("$testname - $filename (unexpected successful parse)");
# 			}
# 		} elsif ($is_neg_nt) {
# 			my (@triples)	= eval { $nt_parser->parse_list_from_bytes($bytes) };
# 			my $ok	= $@ ? 1 : 0;
# 			$self->record_result('syntax', $ok, $test->as_string);
# 			if ($ok) {
# 				pass("$testname - $filename");
# 			} else {
# # 				if ($self->debug) {
# # 					warn $query->as_string;
# # 				}
# 				fail("$testname - $filename (unexpected successful parse)");
# 			}
# 		}
# 	}
# }

sub update_eval_test {
	my $self		= shift;
	my $model		= shift;
	my $test		= shift;
	my %args		= @_;
	my $specVersion	= $args{'specVersion'} // '1.1';

	my ($action)	= $model->objects( $test, iri("${MF}action") )->elements;
	my ($result)	= $model->objects( $test, iri("${MF}result") )->elements;
	my @reqs		= $model->objects( $test, iri("${MF}requires") )->elements;
	my ($approved)	= $model->objects( $test, iri("${DAWGT}approval") )->elements;
	my ($queryd)	= $model->objects( $action, iri("${UT}request") )->elements;
	my @data		= $model->objects( $action, iri("${UT}data") )->elements;
	my @gdata		= $model->objects( $action, iri("${UT}graphData") )->elements;
	
	if ($self->strict_approval) {
		unless ($approved) {
			warn "- skipping test because it isn't approved\n" if ($self->debug);
			return;
		}
		if ($approved->equal(iri("${DAWGT}NotClassified"))) {
			warn "- skipping test because its approval is dawgt:NotClassified\n" if ($self->debug);
			return;
		}
	}
	
	my $uri					= URI->new( $queryd->value );
	my $filename			= $uri->file;
	my (undef,$base,undef)	= File::Spec->splitpath( $filename );
	$base					= "file://${base}";
	warn "Loading SPARQL query from file $filename" if ($self->debug);
	my $sparql				= do { local($/) = undef; open(my $fh, '<', $filename) or do { fail("$!: $filename; " . $test->as_string); return }; binmode($fh, ':utf8'); <$fh> };

	my $q			= $sparql;
	$q				=~ s/\s+/ /g;
	if ($self->debug) {
		warn "### test     : " . $test->value . "\n";
		warn "# sparql     : $q\n";
		warn "# file       : $filename\n";
		foreach my $data (@data) {
			warn "# data       : " . $data->value . "\n" if (blessed($data));
		}
		warn "# graph data : " . $_->value . "\n" for (@gdata);
		warn "# result     : " . $result->value . "\n";
		foreach my $req (@reqs) {
			warn "# requires   : " . $req->value . "\n" if (blessed($req));
		}
	}
	
	my $todo_because_of_test_req	= 0;
	my @unsupported_reqs;
	foreach my $req (@reqs) {
		unless (exists ${ $self->supported_extensions }{ $req->value }) {
			$todo_because_of_test_req++;
			push(@unsupported_reqs, $req->value);
		}
	}
	
	
	
	# TODO: set up remote endpoint mock