#!/usr/bin/perl use strict; use warnings; no warnings 'redefine'; use File::Spec; use lib qw(. t); BEGIN { require "models.pl"; } use Test::More; my $tests = 7; my @models = test_models( qw(data/foaf.xrdf) ); plan tests => 1 + ($tests * scalar(@models)); use_ok( 'RDF::Query' ); ################################################################################ Log::Log4perl::init( \q[ log4perl.category.rdf.query.plan.computedtriple = DEBUG, Screen log4perl.appender.Screen = Log::Log4perl::Appender::Screen log4perl.appender.Screen.stderr = 0 log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout ] ); ################################################################################ foreach my $model (@models) { print "\n#################################\n"; print "### Using model: $model\n"; SKIP: { { print "# computed predicate: list:member\n"; my $query = new RDF::Query ( <<"END", undef, undef, 'sparql11' ); PREFIX test: PREFIX list: SELECT ?member WHERE { ?x test:mycollection ?list . ?list list:member ?member . } END $query->add_computed_statement_generator( 'http://www.jena.hpl.hp.com/ARQ/list#member' => \&__compute_list_member ); my $count = 0; my $stream = $query->execute( $model ); my %expect = map { $_ => 1 } (1,2,3); while (my $row = $stream->next) { isa_ok( $row->{member}, 'RDF::Query::Node::Literal' ); my $value = $row->{member}->literal_value; ok( exists($expect{ $value }), "got expected value $value"); delete $expect{ $value }; } continue { ++$count }; is( $count, 3, 'expecting three list members' ); } } } sub __compute_list_member { my $query = shift; my $bound = shift; my $s = shift; my $p = shift; my $o = shift; my $c = shift; my $first = RDF::Query::Node::Resource->new( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#first' ); my $rest = RDF::Query::Node::Resource->new( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#rest' ); use Scalar::Util qw(blessed); if (blessed($p) and $p->isa('RDF::Query::Node::Resource') and $p->uri_value( 'http://www.jena.hpl.hp.com/ARQ/list#member' )) { my @lists; my $lists = ($c) ? $query->model->get_named_statements( $s, $first, $o, $c ) : $query->model->get_statements( $s, $first, $o ); while (my $l = $lists->next) { push(@lists, [$l, $l->subject]); } my %seen; my $sub = sub { # warn 'trying to compute list:member'; my ($listst, $list, $head); while (1) { unless (scalar(@lists)) { # warn "no more lists to check"; return undef; } my $data = shift(@lists); ($listst, $head) = @$data; $list = $listst->subject; if ($seen{ $head->as_string, $list->as_string }++) { # warn "already seen this list..."; next; } else { last; } } # warn "checking list " . $list->as_string; return undef if (blessed($list) and $list->isa('RDF::Query::Node::Resource') and $list->uri_value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#nil'); my $obj = $listst->object; my $tail = ($c) ? $query->model->get_named_statements( $list, $rest, undef, $c ) : $query->model->get_statements( $list, $rest, undef ); while (my $st = $tail->next) { my $lists = ($c) ? $query->model->get_named_statements( $st->object, $first, $o, $c ) : $query->model->get_statements( $st->object, $first, $o ); while (my $st = $lists->next) { push(@lists, [$st, $head]); } } my $newhead = $head; my $st = RDF::Query::Algebra::Triple->new( $head, RDF::Query::Node::Resource->new('http://www.jena.hpl.hp.com/ARQ/list#member'), $obj ); return $st; }; return RDF::Trine::Iterator::Graph->new( $sub ); } }