view release on metacpan or  search on metacpan

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

		unless ($approved) {
			warn "- skipping test because it isn't approved\n" if ($self->debug);
			return;
		}
		if ($approved->equal("${DAWGT}NotClassified")) {
			warn "- skipping test because its approval is dawgt:NotClassified\n" if ($self->debug);
			return;
		}
	}

	my $is_pos_query	= $model->count_quads($test, $type, iri("${MF}PositiveSyntaxTest11"));
	my $is_pos_update	= $model->count_quads($test, $type, iri("${MF}PositiveUpdateSyntaxTest11"));
	my $is_neg_query	= $model->count_quads($test, $type, iri("${MF}NegativeSyntaxTest")) + $model->count_quads($test, $type, iri("${MF}NegativeSyntaxTest11"));
	my $is_neg_update	= $model->count_quads($test, $type, iri("${MF}NegativeUpdateSyntaxTest")) + $model->count_quads($test, $type, iri("${MF}NegativeUpdateSyntaxTest11"));
	
	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, '<:utf8', $filename) or do { warn("$!: $filename; " . $test->as_string); return }; <$fh> };
	my $bytes	= encode_utf8($sparql);

	if ($self->debug) {
		my $q			= $sparql;
		$q				=~ s/\s+/ /g;
		warn "### test     : " . $test->as_string . "\n";
		warn "# file       : $filename\n";
		warn "# sparql     : $q\n";
	}
	
	my $pclass	= Attean->get_parser('SPARQL');
	my $parser	= $pclass->new();
	if ($test_type eq 'update') {
		$parser->update(1);
	}
	if ($is_pos_query or $is_pos_update) {
		my ($query)	= eval { $parser->parse_list_from_bytes($bytes) };
		my $ok	= blessed($query);
		$self->record_result('syntax', $ok, $test->as_string);
		if ($ok) {
			pass("syntax $namevalue: $filename");
		} else {
			fail("syntax $namevalue; $filename: $@");
		}
	} elsif ($is_neg_query or $is_neg_update) {
		my ($query)	= eval { $parser->parse_list_from_bytes($bytes) };
		my $ok	= $@ ? 1 : 0;
		$self->record_result('syntax', $ok, $test->as_string);
		if ($ok) {
			pass("syntax $namevalue: $filename");
		} else {
			if ($self->debug) {
				warn $query->as_string;
			}
			fail("syntax $namevalue; $filename (unexpected successful parse)");
		}
	}
}

sub update_eval_test {
	my $self		= shift;
	my $model		= shift;
	my $test		= shift;
	my $count		= shift // 1;
	
	my ($action)	= $model->objects( $test, iri("${MF}action") )->elements;
	my ($result)	= $model->objects( $test, iri("${MF}result") )->elements;
	my ($req)		= $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";
		foreach my $data (@data) {
			warn "# data       : " . $data->value . "\n" if (blessed($data));
		}
		warn "# graph data : " . $_->value . "\n" for (@gdata);
		warn "# result     : " . $result->value . "\n";
		warn "# requires   : " . $req->value . "\n" if (blessed($req));
	}
	
	# TODO: set up remote endpoint mock

	warn "constructing model...\n" if ($self->debug);
	my $test_model	= $self->test_model();
	foreach my $data (@data) {
		eval {
			if (blessed($data)) {
				$test_model->load_urls_into_graph($self->default_graph, $data);
			}
		};
		if ($@) {
			fail($test->value);
			print "# died: " . $test->value . ": $@\n";
			return;
		}
	}