view release on metacpan or  search on metacpan

lib/Apache/SPARQL/RDFStore.pm  view on Meta::CPAN

        	$class->_error( $ap, "Negative LIMIT $limit" );
		return $Apache::SPARQL::Responses{ 'OperationPointError' };
		};

	if( $format !~ s/^\s*(rdfxml|ntriples|xml)\s*$/$1/ ) {
		$class->_error( $ap, "Format $format is not supported" );
		return $Apache::SPARQL::Responses{ 'OperationPointError' };
		};

	#
	# more advanced stuff
	#
	# Any other CGI paramter starting with the 'rdflet_' prefix is passed down to the SPARQL query itself, and can be referred
	# into the SPARQL query as $$param_name. Multiple parameters result into a OR-ed list of value - each value can be either
	# a full qulified URI resource or a literal (with it xml:lang or rdf:datatype attached), using some N-Triples/Turtle like syntax.
	#	
	# Example:
	#
	# Given /sparql/?sparqlet_URL=<http://foo.bar/com.html>
	#
	# and the following SPARQL '&query' paramter
	#
	#       prefix dc: <http://purl.org/dc/elements/1.1/>
	#       select ?title
	#       where ( $$URL dc:title ?title )
	#
	# would re-write the query as:
	#
	#       prefix dc: <http://purl.org/dc/elements/1.1/>
	#       select ?title
	#       where ( <http://foo.bar/com.html> dc:title ?title )
	#
	# which will get the title of item 'http://foo.bar/com.html' - similarly if sparqler_title="foo bar title"@ch and so on..

	my %sparqlet_parameters = ();
	my @params = $class->_param( $ap ); #any param
	map {
		my $name = $_;
		if ( $name =~ s/^sparqlet_// ) {
			$sparqlet_parameters{ $name } = { 'r' => [], 'l' => [] }
				unless( exists $sparqlet_parameters{ $name } );

			my @values = $class->_param( $ap, 'sparqlet_'.$name );
			foreach my $value ( @values ) {
				if ( $value =~ s/^\s*\<([^>]+)\>\s*// ) {
					push @{ $sparqlet_parameters{ $name }->{ 'r' } }, $1;
				} elsif( $value =~ s/^\s*(%?[\"\']((([^\"\'\\\n\r])|(\\([ntbrf\\'\"])|([0-7][0-7?)|([0-3][0-7][0-7])))*)[\"\'](\@([a-z0-9]+(-[a-z0-9]+)?))?%?)\s*// ) {
					push @{ $sparqlet_parameters{ $name }->{ 'l' } }, $1;
					};
				};
			};
		} @params;

	# merge graph-id/s and 
	#if( $class->_SPARQLhas_Source( $query ) ) {
	#} else {
	#	};
	my $data = new RDFStore::Model;
	if($graph_id) {
		foreach my $graph_id ( @{ $graph_id } ) {
			# bad - try to guess out format from file extension
			eval {
				$data->getReader( ($graph_id =~ /\.(nt|ntriples)$/) ? 'N-Triples' : 'RDF/XML' )->parsestring(
					$class->_cat( $ap, $graph_id ) );
				};
			if($@) {
        			$class->_error( $ap, "Cannot process graph-id $graph_id: $@ " );
				return $Apache::SPARQL::Responses{ 'OperationPointError' };
				};
			};
		};

	my $dbh = DBI->connect("DBI:RDFStore:", "sparqler", 0, {
			'sourceModel' => $data,
			'smarter' => $smart } );

	unless($dbh) {
        	$class->_error( $ap, "Oh dear, can not connect to rdfstore: $!" );
        	return $Apache::SPARQL::Responses{ 'OperationPointError' };
		};

	$query = $class->_preprocess_SPARQL_query( $ap, $query, %sparqlet_parameters );

	my $sth;
	eval {
		$sth=$dbh->prepare($query);
		$sth->execute();
		};

	if($@) {
		$sth->finish;
		$class->_error( $ap, "Malformed query: $@ " );
		return $Apache::SPARQL::Responses{ 'MalformedQuery' };
		};

	my $serialization_format;
	if( $sth->func('getQueryStatement')->getQueryType eq 'SELECT' ) {
		if( $format eq 'rdfxml' ) {
			# which is the RDF/XML result format
			# see http://www.w3.org/2001/sw/DataAccess/tests/result-set#
			$serialization_format = 'dawg-results';
		} elsif( $format eq 'xml' ) {
			# see http://www.w3.org/2001/sw/DataAccess/rf1/
			$serialization_format = 'dawg-xml';
		} elsif( $format eq 'ntriples' ) {
			if( $output_xslt ) {
				$sth->finish;
				$class->_error( $ap, "N-Triples output can be applied to XSLT style-sheet $output_xslt" );
				return $Apache::SPARQL::Responses{ 'OperationPointError' };
				};
	
			$serialization_format = 'N-Triples';
			};

		# XSLT and limit make sense only for SELECT queries due we do return dawg-xml format
		my $tot=0;
		if( $output_xslt ) {

			# prepare to output things
			$ap->content_type( ( $output_type ) ? $output_type : $class->_get_content_type( $format ) );

lib/Apache/SPARQL/RDFStore.pm  view on Meta::CPAN

        			$ap->print( $stylesheet->output_string($results) );

				}; # end eval

                	if($@) {
				$sth->finish;
				$class->_error( $ap, "Cannot process query output with $output_xslt XSLT style-sheet: $@ " );
				return $Apache::SPARQL::Responses{ 'OperationPointError' };
				};
		} else {
			# prepare to output things
			$ap->content_type( $class->_get_content_type( $format ) );

			if (! $class->_mp2 ) {
				$ap->send_http_header();
				};

			# we stream otherwise

			eval {

			if( defined $limit and $limit == 0 ) {
				# HACK due we do not do LIMIT into our SPARQL engine yet
				my $xml = $sth->func( $serialization_format, 'fetchrow_XML' );
				$xml =~ m|<results>|;
				$xml = $` . $& . '</results></sparql>';
				$ap->print( $xml );
			} else {
				while ( my $xml = $sth->func( $serialization_format, 'fetchrow_XML' ) ) {
					$tot++;
					if( defined $limit and $tot == $limit ) {
						$xml .= '</results></sparql>'
							unless( $xml =~ m|</results>\s*</sparql>\s*$|m ); # HACK!

						$ap->print( $xml );

						last;
					} else {
						$ap->print( $xml );
						};
					};
				};
			
				}; # end eval

                	if($@) {
				$sth->finish;
				$class->_error( $ap, "Cannot process query output with $output_xslt XSLT style-sheet: $@ " );
				return $Apache::SPARQL::Responses{ 'OperationPointError' };
				};
			};
	} else {
		# prepare to output things
		$ap->content_type( $class->_get_content_type( $format ) );

		if (! $class->_mp2 ) {
			$ap->send_http_header();
			};

		# we need to reject output-xslt param here I guess

		if( $format eq 'rdfxml' ) {
			$serialization_format = 'RDF/XML';
		} elsif( $format eq 'xml' ) {
			$sth->finish;
			$class->_error( $ap, "XML output is not possible but SELECT queries" );
			return $Apache::SPARQL::Responses{ 'OperationPointError' };
		} elsif( $format eq 'ntriples' ) {
			$serialization_format = 'N-Triples';
			};

		eval {

		while (my $rdf = $sth->func( $serialization_format, 'fetchsubgraph_serialize' )) {
			# we stream otherwise
			$ap->print( $rdf );
			};

			}; # end eval
		};

	$sth->finish;

        return $Apache::SPARQL::Responses{ 'OK' };
        };

sub _preprocess_SPARQL_query {
	my ( $class, $ap, $query, %parameters ) = @_;

	my $preprocessed_query = $query;

        foreach my $param ( keys %parameters ) {
		my $to_substitute = '';
		if ( scalar( @{$parameters{ $param }->{'r'}} ) > 0 ) {
			$to_substitute = '<' .  join(' , ', @{ $parameters{ $param }->{'r'} } ) . '>';
		} elsif( scalar( @{$parameters{ $param }->{'l'}} ) == 1 ) {
			$to_substitute = $parameters{ $param }->{'l'}->[0];
		} elsif( scalar( @{$parameters{ $param }->{'l'}} ) > 1 ) {
			$to_substitute = '<' .  join(' , ', @{ $parameters{ $param }->{'l'} } ) . '>';
			};

                $preprocessed_query =~ s|\$\$$param|$to_substitute|mig;
                };

        #$class->_debug( $ap, "PREPROCESSED_QUERY:\n\n$preprocessed_query\n\n" );

        return $preprocessed_query;
	};

sub _error {
	my ($class, $ap, $err ) = @_;

	$ap->log()->error( " [ Apache::SPARQL::RDFStore ERROR ] $err " );
	};

sub _debug {
	my ($class, $ap, $msg ) = @_;

	$ap->log()->error( " [ Apache::SPARQL::RDFStore DEBUG ] $msg " );
	};