view release on metacpan or  search on metacpan

lib/DBD/RDFStore.pm  view on Meta::CPAN

				# a solution would be to have an in-memory model anyway
				#smush() will be better at some point :)
				my $ee = $model->elements;
				while ( my $ss = $ee->each ) {
					$source_model->add( $ss );
					};
			} else {
				#$model = $model->duplicate #which is bad for the moment but allows "to join distributed searches" :-)
				#	if(	( scalar(@{$sth->{'Statement'}->{sources}}) > 0 ) &&
				#		( $model->isRemote ) );
				$source_model=$model;
				};
			};
		unless(defined $source_model) {
			$sth->DBI::set_err( 1, "Cannot process RDF input: $@" );
			return undef;
			};
	} else {
		$source_model=$sth->{'SOURCE_MODEL'};
                };    

        unless(defined $source_model) {
                $sth->DBI::set_err( 1, "Cannot detect RDF input" );
                return undef;
                };

	#print STDERR $source_model->serialize(undef,'RDF/XML')."\n";

	$sth->{'source_model'} = $source_model;

	# zap the whole model
	if(	( $sth->{'Statement'}->getQueryType eq 'DELETE' ) &&
		($#{$sth->{'Statement'}->{resultVars}}==0) &&
		($sth->{'Statement'}->{resultVars}->[0] eq '*') ) {
		my $elements = $sth->{'source_model'}->elements;
		while( my $st = $elements->each ) {	
			unless($sth->{'source_model'}->remove( $st )) {
				$sth->DBI::set_err( 1, "Cannot DELETE triple ". $st->toString );
                		return undef;
				};
			};
		};

        return '0E0'; #we do *not* want to know the number of rows affected at the moment due to efficency problems :)
	};

# fetch the next result set (row)
# This subroutine runs a depth-first like visit of the graph matching the triple patterns (even if we do not really 
# have an in-memory rep of the query process!)
# i.e. the way we visit the graph (backtrack) is "told" by the triple-patterns in the query
# i.e. $sth->{'result'} = ( '?x' => 1, '?y' => Test1 )
#
sub _nextMatch {
        my( $sth, $rpi, $gp, $tpi, %bind ) = @_;

	if($DBD::RDFStore::st::debug>1) {
		print STDERR (" " x $tpi);
		print STDERR "$tpi BEGIN\n";	
		};

	# if we have a previous state try to recover it (this is needed for streaming results)
	my $bind_state = pop @{ $sth->{'binds'} };

	if(	( $bind_state ) && ($DBD::RDFStore::st::debug>1) ) {
		print STDERR (" " x $tpi);
		print STDERR "RECOVER previous state for $tpi\n";
		};

	_nextMatch( $sth, $rpi, $gp, $tpi+1, %{$bind_state} )
		if( $bind_state );

	#we stop on the way if some result was matched already
	if ( scalar(keys %{$sth->{'result'}}) > 0 ) {
		#save actual state on the stack
		push @{ $sth->{'binds'} }, \%bind
			if(	scalar(keys %bind) > scalar(keys %{$gp->{'previous_bindings'}}) and #did we got new columns? (correct??!?!)
				scalar(keys %bind) > 0 );

		if($DBD::RDFStore::st::debug>1) {
			print STDERR (" " x $tpi);
			print STDERR "$tpi GOT NEW RESULT ready (top)\n";
			};

		return;
		};

	if ( $tpi > $#{$gp->{triplePatterns}} ) {
		# actually copy the new result
		map { $sth->{'result'}->{$_} = $bind{$_}; } keys %bind;

		return;
		};

	delete( $sth->{'iterators'}->{$rpi}->{$tpi} ) #retry
		if(     $gp->{'optional'} and #optional block?
			exists $sth->{'iterators'}->{$rpi}->{$tpi} and
               		! $sth->{'iterators'}->{$rpi}->{$tpi}->{itr}->hasnext ); # and previous iterator is over?

	# we want to keep the current iterator state and avoid to run the same query over and over again
	unless( exists $sth->{'iterators'}->{$rpi}->{$tpi} ) {
		$sth->{'iterators'}->{$rpi}->{$tpi} = {};

		#substitute %bind into i-esim triple-pattern if possible and needed

		if($DBD::RDFStore::st::debug>1) {
			print STDERR (" " x $tpi);
			print STDERR "$tpi BEFORE substitute: TP( ",join(',',@{ $gp->{triplePatterns}->[$tpi] })," )\n";
			};

		my @tp;
		my %vars;
		$sth->{'iterators'}->{$rpi}->{$tpi}->{vars} = {};
		$sth->{'iterators'}->{$rpi}->{$tpi}->{optional} = 0;
		my @tp_copy; # local copy of i-esim triple-pattern - needed??!?
		for my $i ( 0..$#{$gp->{triplePatterns}->[$tpi]} ) {
			if($i==0) {
				$sth->{'iterators'}->{$rpi}->{$tpi}->{optional} = $gp->{triplePatterns}->[$tpi]->[$i];
				next;
				};
			push @tp_copy, $gp->{triplePatterns}->[$tpi]->[$i];
			};

lib/DBD/RDFStore.pm  view on Meta::CPAN

	my $XML;
	while( my $xml_match = fetchrow_XML( $sth, $syntax ) ) {
		if($XML) {
			$XML .= $xml_match;
		} else {
			$XML = $xml_match;
			};
		};

	return $XML;
	};

# return string containing the RDF subgraph matching
# syntax: RDF/XML, dawg-results or N-Triples
sub fetchsubgraph_serialize {
        my($sth, $syntax) = @_;

	return
		unless($syntax =~ m#(RDF/XML|N-Triples)#i);

	if($sth->{'RDF_or_XML_stream_finished'}) {
		$sth->{'RDF_or_XML_stream_finished'} = 0;
		return;
		};

	return _fetchrow_RDF_or_XML( $sth, $syntax );
	};

# return string containing the whole RDF graph matching
# syntax: RDF/XML, dawg-results or N-Triples
sub fetchallgraph_serialize {
        my($sth, $syntax) = @_;

	return
		unless($syntax =~ m#(RDF/XML|N-Triples)#i);

	my $RDF;
	while( my $rdf_subgraph = fetchsubgraph_serialize( $sth, $syntax ) ) {
		if($RDF) {
			$RDF .= $rdf_subgraph;
		} else {
			$RDF = $rdf_subgraph;
			};
		};

	return $RDF;
	};

# return RDFStore::Model of matching statements for i-esim iteration
sub fetchsubgraph {
        my($sth) = @_;

	if($sth->{'RDF_or_XML_stream_finished'}) {
		$sth->{'RDF_or_XML_stream_finished'} = 0;
		return;
		};

	return _fetchrow_RDF_or_XML( $sth );
	};

# fetch the whole matching graph in one call (not streaming then)
# return RDFStore::Model of matching statements
sub fetchallgraph {
        my($sth) = @_;

	my $whole_graph;
	while ( my $graph = fetchsubgraph($sth) ) {
		$whole_graph = $graph
			unless($whole_graph);
		my $e = $graph->elements;
		while(my $ss = $e->each) {
			$whole_graph->add($ss);
			};
		};

	return $whole_graph;
	};

# should be streaming
sub _fetchrow_RDF_or_XML {
        my($sth, $syntax) = @_;

	return
		if($sth->{'RDF_or_XML_stream_finished'});

	unless($syntax) {
		$syntax = $sth->{'results'}->{'syntax'}
			if(exists $sth->{'results'}->{'syntax'});
		};

	return
		unless(	(!$syntax) ||
			($syntax =~ m#(RDF/XML|N-Triples|dawg-results|rdf-for-xml|dawg-xml)#i) );

	my $result = '';

	my $mm = new RDFStore::Model; # we want streaming - that's why this...

	# DESCRIBE <URI> are done once in one single subgraph / match
	if(	( $sth->{'Statement'}->getQueryType eq 'DESCRIBE' ) &&
		( grep m/^<([^>]+)>/, @{ $sth->{'Statement'}->{'describes'} }) ) {
		foreach my $d ( @{ $sth->{'Statement'}->{'describes'} } ) {
			next
				unless($d =~ m/^<([^>]+)>/);

			$d = $1;

			my $describe = $sth->{'source_model'}->{rdfstore}->fetch_object(
				$sth->{'FACTORY'}->createResource( $d ) ); #SOURCE / context is not known in SPARQL??

			if($describe) {
				while( my $ss = $describe->each ) {
					$mm->add( $ss );
					};
				};
			};

		$sth->{'RDF_or_XML_stream_finished'} = 1; # must be reset by caller

		if($syntax =~ m#(RDF/XML|dawg-results|rdf-for-xml|dawg-xml)#i) {
			$result .= '<?xml version="1.0"?>'."\n";
			$result .= "\n<!--\n" . $sth->{'results'}->{'comment'} ."\n-->\n\n"
				if(exists $sth->{'results'}->{'comment'});
		} elsif($syntax =~ m/N-Triples/i) {
			$result .= join('# ',split(/\n/,$sth->{'results'}->{'comment'})) ."\n\n"
				if(exists $sth->{'results'}->{'comment'});
			};

		if( $syntax ) {
			$result .= $mm->serialize( undef, $syntax );

			return $result;
		} else {
			return $mm;
			};
		};

	my $first=(scalar( keys %{$sth->{'result'}} ) <= 0 ) ? 1 : 0 ;

	if($first) {
		if($syntax =~ m#(RDF/XML|dawg-results|rdf-for-xml|dawg-xml)#i) {
			$result .= '<?xml version="1.0"?>'."\n";
			$result .= "\n<!--\n" . $sth->{'results'}->{'comment'} ."\n-->\n\n"
				if(exists $sth->{'results'}->{'comment'});
		} elsif($syntax =~ m/N-Triples/i) {
			$result .= join('# ',split(/\n/,$sth->{'results'}->{'comment'})) ."\n\n"
				if(exists $sth->{'results'}->{'comment'});
			};
		if( $sth->{'Statement'}->getQueryType eq 'SELECT' ) {
			if($syntax =~ m/dawg-results/i) {
				# see http://www.w3.org/2001/sw/DataAccess/tests/result-set#
				$sth->{'num_results'}=0;
				$result .=  "<rdf:RDF\n   xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#'   xmlns:rs='http://www.w3.org/2001/sw/DataAccess/tests/result-set#'>\n<rs:ResultSet rdf:about=''>\n";
				map {
					my $ff = $_;
					$ff =~ s/^[\?\$]//;
        				$result .= "      <rs:resultVariable>$ff</rs:resultVariable>\n";