view release on metacpan or  search on metacpan

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

		}
		unless ($algebra) {
			warn "No algebra generated for update\n";
			fail($test->value);
			return;
		}
		if ($self->debug) {
			warn "# Algebra:\n" . $algebra->as_string . "\n";
		}
	
		my $default_graphs	= [$self->default_graph];
		my $planner	= Attean::IDPQueryPlanner->new();
		my $plan	= $planner->plan_for_algebra($algebra, $test_model, $default_graphs);
		if ($self->debug) {
			warn "# Plan:\n" . $plan->as_string . "\n";
		}

		if ($self->debug) {
			warn "Running update...\n";
		}
		my $iter	= $plan->evaluate($test_model);
		$iter->elements;
		if ($self->debug) {
			warn "done.\n";
		}
	
		if ($self->debug) {
			warn "Comparing results...\n";
		}
		my $eqtest	= Attean::BindingEqualityTest->new();
		my $eq		= $eqtest->equals($test_model, $expected_model);
		if ($self->debug) {
			warn "done.\n";
		}
		$ok			= is( $eq, 1, $test->value );
		unless ($ok) {
			warn $eqtest->error;
			warn "Got model:\n" . $self->model_as_string($test_model);
			warn "Expected model:\n" . $self->model_as_string($expected_model);
		}
	};
	if ($@) {
		warn "Failed to execute update: $@";
		fail($test->value);
	}
	if (not($ok)) {
		print "# failed: " . $test->value . "\n";
	}

	warn "ok\n" if ($self->debug);
}

sub construct_data {
	my $self	= shift;
	my $model	= shift;
	my $action	= shift;
	my ($queryd)	= $model->objects( $action, iri("${RQ}query") )->elements;
	my @data		= $model->objects( $action, iri("${RQ}data") )->elements;
	my @gdata		= $model->objects( $action, iri("${RQ}graphData") )->elements;
	my @sdata		= $model->objects( $action, iri("${RQ}serviceData") )->elements;
	my @cdata		= $model->objects( $action, iri("${RQ}constructDataFile") )->elements;
	my ($fnode)		= $model->objects( $action, iri("${RQ}format") )->elements;
	my $format		= blessed($fnode) ? $fnode->value : 'text/turtle';

	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 { warn("$!: $filename"); return }; binmode($fh, ':utf8'); <$fh> };
	
	my $test_model	= $self->test_model();
	foreach my $data (@data) {
		if (blessed($data)) {
			$test_model->load_urls_into_graph($self->default_graph, $data);
		}
	}
	foreach my $g (@gdata) {
		my $start = $test_model->size;
		$test_model->load_urls_into_graph($g, $g);
		my $end	= $test_model->size;
		unless ($start < $end) {
			warn "*** Loading file did not result in any new quads: " . $g;
		}
	}
	foreach my $n (@cdata) {
		my ($bytes, $format)	= $self->construct_data($model, $n);
		my $p					= Attean->get_parser(media_type => $format)->new();
		my $iter				= $p->parse_iter_from_bytes($bytes);
		$test_model->add_iter($iter->as_quads($self->default_graph));
	}
	
	print STDERR "ok\n" if ($self->debug);

	if ($self->debug) {
		my $q	= $sparql;
		$q		=~ s/([\x{256}-\x{1000}])/'\x{' . sprintf('%x', ord($1)) . '}'/eg;
		warn $q;
	}
	
	my ($iter, $type)		= $self->get_actual_results( $filename, $test_model, $sparql, $base, $model, \@sdata );
	my $sclass				= Attean->get_serializer(media_type => $format);
	my $s					= $sclass->new();
	my $bytes				= $s->serialize_iter_to_bytes($iter);
	return ($bytes, $format);
}

sub query_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("${RQ}query") )->elements;
	my @data		= $model->objects( $action, iri("${RQ}data") )->elements;
	my @gdata		= $model->objects( $action, iri("${RQ}graphData") )->elements;
	my @sdata		= $model->objects( $action, iri("${RQ}serviceData") )->elements;
	my @cdata		= $model->objects( $action, iri("${RQ}constructDataFile") )->elements;
	
	if ($self->strict_approval) {
		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 $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 { warn("$!: $filename; " . $test->value); 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 =~ s#file://##r) . "\n" if (blessed($data));
		}
		warn "# graph data       : " . ($_->value =~ s#file://##r) . "\n" for (@gdata);
		warn "# constructed data : " . ($_->value =~ s#file://##r) . "\n" for (@cdata);
		warn "# result           : " . ($result->value =~ s#file://##r) . "\n";
		warn "# requires         : " . ($req->value =~ s#file://##r) . "\n" if (blessed($req));
	}
	
STRESS:	foreach (1 .. $count) {
		print STDERR "constructing model... " if ($self->debug);
		my $test_model	= $self->test_model();
		my $next_stress	= 0;
		try {
			foreach my $data (@data) {
				if (blessed($data)) {
					$test_model->load_urls_into_graph($self->default_graph, $data);
				}
			}
			foreach my $g (@gdata) {
				my $start = $test_model->size;
				$test_model->load_urls_into_graph($g, $g);
				my $end	= $test_model->size;
				unless ($start < $end) {
					warn "*** Loading file did not result in any new quads: " . $g;
				}
			}
			foreach my $n (@cdata) {
				my ($bytes, $format)	= $self->construct_data($model, $n);
				my $p					= Attean->get_parser(media_type => $format)->new();
				my $iter				= $p->parse_iter_from_bytes($bytes);
				$test_model->add_iter($iter->as_quads($self->default_graph));
			}
		} catch {
			fail($test->value);
			$self->record_result('evaluation', 0, $test->value);
			print "# died: " . $test->value . ": $_\n";
			$next_stress++;
		};
		next STRESS if $next_stress;
		print STDERR "ok\n" if ($self->debug);

		my $resuri		= URI->new( $result->value );
		my $resfilename	= $resuri->file;
	
		TODO: {
			local($TODO)	= (blessed($req)) ? "requires " . $req->value : '';
			my $comment;
			eval {
				if ($self->debug) {
					my $q	= $sparql;
					$q		=~ s/([\x{256}-\x{1000}])/'\x{' . sprintf('%x', ord($1)) . '}'/eg;
					warn $q;
				}
				
				my ($actual, $type);
				{
					local($::DEBUG)	= 1;
					print STDERR "getting actual results... " if ($self->debug);
					($actual, $type)		= $self->get_actual_results( $filename, $test_model, $sparql, $base, $model, \@sdata );
					print STDERR "ok\n" if ($self->debug);
				}
			
				print STDERR "getting expected results... " if ($self->debug);
				my $expected	= $self->get_expected_results( $resfilename, $type );
				print STDERR "ok\n" if ($self->debug);
			
			#	warn "comparing results...";
				$self->compare_results( $expected, $actual, $test->value, \$comment );
			};
			
			my $ok	= not($@);
			unless ($ok) {
				warn $@;
				fail($test->value);
				$self->record_result('evaluation', 0, $test->value);
			};
			if ($ok) {
			} else {
				print "# failed: " . $test->value . "\n";
			}
		}
	}
}

sub mock_endpoints {
	my $self			= shift;
	my $mock			= shift;