1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2010-2017, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(sparql_client, 37 [ sparql_query/3, % +Query, -Row, +Options 38 sparql_set_server/1, % +Options 39 sparql_read_xml_result/2, % +Stream, -Result 40 sparql_read_json_result/2 % +Input, -Result 41 ]). 42:- use_module(library(http/http_open)). 43:- use_module(library(http/json)). 44:- use_module(library(lists)). 45:- use_module(library(rdf)). 46:- use_module(library(semweb/turtle)). 47:- use_module(library(option)). 48:- use_module(library(uri)).
rdf(S,P,O)
for CONSTRUCT
and DESCRIBE
queries, row(...)
for
SELECT
queries and true
or false
for ASK
queries.
Options are
Variables that are unbound in SPARQL (e.g., due to SPARQL optional
clauses), are bound in Prolog to the atom '$null$'
.
SELECT
query.
Remaining options are passed to http_open/3. The defaults for
Host, Port and Path can be set using sparql_set_server/1. The
initial default for port is 80 and path is /sparql/
.
For example, the ClioPatria server understands the parameter
entailment
. The code below queries for all triples using
_rdfs_entailment.
?- sparql_query('select * where { ?s ?p ?o }', Row, [ search([entailment=rdfs]) ]).
123sparql_query(Query, Row, Options) :-
124 ( select_option(endpoint(URL), Options, Options5)
125 -> uri_components(URL, Components),
126 uri_data(scheme, Components, Scheme),
127 uri_data(authority, Components, Auth),
128 uri_data(path, Components, Path),
129 uri_data(search, Components, Extra),
130 ignore(Extra = []),
131 uri_authority_components(Auth, AComp),
132 uri_authority_data(host, AComp, Host),
133 uri_authority_data(port, AComp, Port),
134 ( var(Port)
135 -> sparql_port(Scheme, Port, _, _)
136 ; true
137 )
138 ; sparql_param(scheme(Scheme), Options, Options1),
139 sparql_port(Scheme, Port, Options1, Options2),
140 sparql_param(host(Host), Options2, Options3),
141 sparql_param(path(Path), Options3, Options4),
142 select_option(search(Extra), Options4, Options5, [])
143 ),
144 select_option(variable_names(VarNames), Options5, Options6, _),
145 sparql_extra_headers(HTTPOptions),
146 http_open([ scheme(Scheme),
147 host(Host),
148 port(Port),
149 path(Path),
150 search([ query = Query
151 | Extra
152 ])
153 | Options6
154 ], In,
155 [ header(content_type, ContentType),
156 status_code(Status)
157 | HTTPOptions
158 ]),
159 plain_content_type(ContentType, CleanType),
160 read_reply(Status, CleanType, In, VarNames, Row).
169sparql_extra_headers( 170 [ request_header('Accept' = 'application/sparql-results+xml, \c 171 application/n-triples, \c 172 application/x-turtle; q=0.9, \c 173 application/turtle; q=0.9, \c 174 text/turtle, \c 175 application/sparql-results+json, \c 176 application/rdf+xml, \c 177 text/rdf+xml; q=0.8, \c 178 */*; q=0.1'), 179 cert_verify_hook(ssl_verify) 180 ]). 181 182:- public ssl_verify/5.
188ssl_verify(_SSL,
189 _ProblemCertificate, _AllCertificates, _FirstCertificate,
190 _Error).
194read_reply(200, ContentType, In, Close, Row) :- 195 !, 196 read_reply(ContentType, In, Close, Row). 197read_reply(Status, _ContentType, In, _Close, _Row) :- 198 call_cleanup(read_string(In, _, Reply), 199 close(In, [force(true)])), 200 throw(error(sparql_error(Status, Reply), _)). 201 202read_reply('application/rdf+xml', In, _, Row) :- 203 !, 204 call_cleanup(load_rdf(stream(In), RDF), close(In)), 205 member(Row, RDF). 206read_reply(MIME, In, _, Row) :- 207 turtle_media_type(MIME), 208 !, 209 call_cleanup(rdf_read_turtle(stream(In), RDF, []), close(In)), 210 member(Row, RDF). 211read_reply(MIME, In, VarNames, Row) :- 212 sparql_result_mime(MIME), 213 !, 214 call_cleanup(sparql_read_xml_result(stream(In), Result), 215 close(In)), 216 varnames(Result, VarNames), 217 xml_result(Result, Row). 218read_reply(MIME, In, VarNames, Row) :- 219 json_result_mime(MIME), 220 !, 221 call_cleanup(sparql_read_json_result(stream(In), Result), 222 close(In)), 223 ( Result = select(VarNames, Rows) 224 -> member(Row, Rows) 225 ; Result = ask(True) 226 -> Row = True, 227 VarNames = [] 228 ). 229read_reply(Type, In, _, _) :- 230 read_stream_to_codes(In, Codes), 231 string_codes(Reply, Codes), 232 close(In), 233 throw(error(domain_error(sparql_result_document, Type), 234 context(_, Reply))). 235 236turtle_media_type('application/x-turtle'). 237turtle_media_type('application/turtle'). 238turtle_media_type('application/n-triples'). 239turtle_media_type('text/rdf+n3'). 240turtle_media_type('text/turtle'). 241 242sparql_result_mime('application/sparql-results+xml'). % official 243sparql_result_mime('application/sparql-result+xml'). 244 245json_result_mime('application/sparql-results+json'). 246 247 248plain_content_type(Type, Plain) :- 249 sub_atom(Type, B, _, _, (;)), 250 !, 251 sub_string(Type, 0, B, _, Main), 252 normalize_space(atom(Plain), Main). 253plain_content_type(Type, Type). 254 255xml_result(ask(Bool), Result) :- 256 !, 257 Result = Bool. 258xml_result(select(_VarNames, Rows), Result) :- 259 member(Result, Rows). 260 261varnames(ask(_), _). 262varnames(select(VarTerm, _Rows), VarNames) :- 263 VarTerm =.. [_|VarNames]. 264 265 266 /******************************* 267 * SETTINGS * 268 *******************************/ 269 270:- dynamic 271 sparql_setting/1. 272 273sparql_setting(scheme(http)). 274sparql_setting(path('/sparql/')). 275 276sparql_param(Param, Options0, Options) :- 277 select_option(Param, Options0, Options), 278 !. 279sparql_param(Param, Options, Options) :- 280 sparql_setting(Param), 281 !. 282sparql_param(Param, Options, Options) :- 283 functor(Param, Name, _), 284 throw(error(existence_error(option, Name), _)). 285 286sparql_port(_Scheme, Port, Options0, Options) :- 287 select_option(port(Port), Options0, Options), 288 !. 289sparql_port(_Scheme, Port, Options, Options) :- 290 sparql_setting(port(Port)), 291 !. 292sparql_port(http, 80, Options, Options) :- 293 !. 294sparql_port(https, 443, Options, Options) :- 295 !.
sparql_set_server([ host(localhost), port(8080) path(world) ])
The default for port is 80 and path is /sparql/
.
312sparql_set_server([]) :- !. 313sparql_set_server([H|T]) :- 314 !, 315 sparql_set_server(H), 316 sparql_set_server(T). 317sparql_set_server(Term) :- 318 functor(Term, Name, Arity), 319 functor(Unbound, Name, Arity), 320 retractall(sparql_setting(Unbound)), 321 assert(sparql_setting(Term)). 322 323 324 /******************************* 325 * RESULT * 326 *******************************/ 327 328ns(sparql, 'http://www.w3.org/2005/sparql-results#'). 329 330/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 331Read the SPARQL XML result format as defined in 332http://www.w3.org/TR/rdf-sparql-XMLres/, version 6 April 2006. 333- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 334 335 /******************************* 336 * MACRO HANDLING * 337 *******************************/ 338 339% substitute 'sparql' by the namespace defined above for better 340% readability of the remainder of the code. 341 342term_subst(V, _, _, V) :- 343 var(V), 344 !. 345term_subst(F, F, T, T) :- !. 346term_subst(C, F, T, C2) :- 347 compound(C), 348 !, 349 functor(C, Name, Arity), 350 functor(C2, Name, Arity), 351 term_subst(0, Arity, C, F, T, C2). 352term_subst(T, _, _, T). 353 354term_subst(A, A, _, _, _, _) :- !. 355term_subst(I0, Arity, C0, F, T, C) :- 356 I is I0 + 1, 357 arg(I, C0, A0), 358 term_subst(A0, F, T, A), 359 arg(I, C, A), 360 term_subst(I, Arity, C0, F, T, C). 361 362term_expansion(T0, T) :- 363 ns(sparql, NS), 364 term_subst(T0, sparql, NS, T). 365 366 367 /******************************* 368 * READING * 369 *******************************/
v(Name, ...)
and Rows is a
list of row(....)
containing the column values in the
same order as the variable names.true
or false
384:- thread_local 385 bnode_map/2. 386 387sparql_read_xml_result(Input, Result) :- 388 load_structure(Input, DOM, 389 [ dialect(xmlns), 390 space(remove) 391 ]), 392 call_cleanup(dom_to_result(DOM, Result), 393 retractall(bnode_map(_,_))). 394 395dom_to_result(DOM, Result) :- 396 ( sub_element(DOM, sparql:head, _HAtt, Content) 397 -> variables(Content, Vars) 398 ; Vars = [] 399 ), 400 ( Vars == [], 401 sub_element(DOM, sparql:boolean, _, [TrueFalse]) 402 -> Result = ask(TrueFalse) 403 ; VarTerm =.. [v|Vars], 404 Result = select(VarTerm, Rows), 405 sub_element(DOM, sparql:results, _RAtt, RContent) 406 -> rows(RContent, Vars, Rows) 407 ), 408 !. % Guarantee finalization
416variables([], []). 417variables([element(sparql:variable, Att, [])|T0], [Name|T]) :- 418 !, 419 memberchk(name=Name, Att), 420 variables(T0, T). 421variables([element(sparql:link, _, _)|T0], T) :- 422 variables(T0, T). 423 424 425rows([], _, []). 426rows([R|T0], Vars, [Row|T]) :- 427 row_values(Vars, R, Values), 428 Row =.. [row|Values], 429 rows(T0, Vars, T). 430 431row_values([], _, []). 432row_values([Var|VarT], DOM, [Value|ValueT]) :- 433 ( sub_element(DOM, sparql:binding, Att, Content), 434 memberchk(name=Var, Att) 435 -> value(Content, Value) 436 ; Value = '$null$' 437 ), 438 row_values(VarT, DOM, ValueT). 439 440value([element(sparql:literal, Att, Content)], literal(Lit)) :- 441 !, 442 lit_value(Content, Value), 443 ( memberchk(datatype=Type, Att) 444 -> Lit = type(Type, Value) 445 ; memberchk(xml:lang=Lang, Att) 446 -> Lit = lang(Lang, Value) 447 ; Lit = Value 448 ). 449value([element(sparql:uri, [], [URI])], URI) :- !. 450value([element(sparql:bnode, [], [NodeID])], URI) :- 451 !, 452 bnode(NodeID, URI). 453value([element(sparql:unbound, [], [])], '$null$'). 454 455 456lit_value([], ''). 457lit_value([Value], Value).
462sub_element(element(Name, Att, Content), Name, Att, Content). 463sub_element(element(_, _, List), Name, Att, Content) :- 464 sub_element(List, Name, Att, Content). 465sub_element([H|T], Name, Att, Content) :- 466 ( sub_element(H, Name, Att, Content) 467 ; sub_element(T, Name, Att, Content) 468 ). 469 470 471bnode(Name, URI) :- 472 bnode_map(Name, URI), 473 !. 474bnode(Name, URI) :- 475 gensym('__bnode', URI0), 476 assertz(bnode_map(Name, URI0)), 477 URI = URI0.
v(Name, ...)
and Rows is a
list of row(....)
containing the column values in the
same order as the variable names.true
or false
494sparql_read_json_result(Input, Result) :- 495 setup_call_cleanup( 496 open_input(Input, In, Close), 497 read_json_result(In, Result), 498 close_input(Close)). 499 500open_input(stream(In), In, Close) :- 501 !, 502 encoding(In, utf8, Close). 503open_input(In, In, Close) :- 504 is_stream(In), 505 !, 506 encoding(In, utf8, Close). 507open_input(File, In, close(In)) :- 508 open(File, read, In, [encoding(utf8)]). 509 510encoding(In, Encoding, Close) :- 511 stream_property(In, encoding(Old)), 512 ( Encoding == Old 513 -> Close = true 514 ; set_stream(In, encoding(Encoding)), 515 Close = set_stream(In, Encoding, Old) 516 ). 517 518close_input(close(In)) :- 519 !, 520 retractall(bnode_map(_,_)), 521 close(In). 522close_input(_) :- 523 retractall(bnode_map(_,_)). 524 525read_json_result(In, Result) :- 526 json_read(In, JSON), 527 json_to_result(JSON, Result). 528 529json_to_result(json([ head = json(Head), 530 results = json(Body) 531 ]), 532 select(Vars, Rows)) :- 533 memberchk(vars=VarList, Head), 534 Vars =.. [v|VarList], 535 memberchk(bindings=Bindings, Body), 536 !, 537 maplist(json_row(VarList), Bindings, Rows). 538json_to_result(json(JSon), ask(Boolean)) :- 539 memberchk(boolean = @(Boolean), JSon). 540 541 542json_row(Vars, json(Columns), Row) :- 543 maplist(json_cell, Vars, Columns, Values), 544 !, 545 Row =.. [row|Values]. 546json_row(Vars, json(Columns), Row) :- 547 maplist(json_cell_or_null(Columns), Vars, Values), 548 Row =.. [row|Values]. 549 550json_cell(Var, Var=json(JValue), Value) :- 551 memberchk(type=Type, JValue), 552 jvalue(Type, JValue, Value). 553 554json_cell_or_null(Columns, Var, Value) :- 555 memberchk(Var=json(JValue), Columns), 556 !, 557 memberchk(type=Type, JValue), 558 jvalue(Type, JValue, Value). 559json_cell_or_null(_, _, '$null$'). 560 561jvalue(uri, JValue, URI) :- 562 memberchk(value=URI, JValue). 563jvalue(literal, JValue, literal(Literal)) :- 564 memberchk(value=Value, JValue), 565 ( memberchk('xml:lang'=Lang, JValue) 566 -> Literal = lang(Lang, Value) 567 ; memberchk('datatype'=Type, JValue) 568 -> Literal = type(Type, Value) 569 ; Literal = Value 570 ). 571jvalue('typed-literal', JValue, literal(type(Type, Value))) :- 572 memberchk(value=Value, JValue), 573 memberchk('datatype'=Type, JValue). 574jvalue(bnode, JValue, URI) :- 575 memberchk(value=NodeID, JValue), 576 bnode(NodeID, URI)
SPARQL client library
This module provides a SPARQL client. For example:
Or, querying a local server using an
ASK
query:HTTPS servers are supported using the
scheme(https)
option:*/