View source with raw comments or as raw
    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)).

SPARQL client library

This module provides a SPARQL client. For example:

?- sparql_query('select * where { ?x rdfs:label "Amsterdam" }', Row,
                [ host('dbpedia.org'), path('/sparql/')]).

Row = row('http://www.ontologyportal.org/WordNet#WN30-108949737') ;
false.

Or, querying a local server using an ASK query:

?- sparql_query('ask { owl:Class rdfs:label "Class" }', Row,
                [ host('localhost'), port(3020), path('/sparql/')]).
Row = true.

HTTPS servers are supported using the scheme(https) option:

?- sparql_query('select * where { ?x rdfs:label "Amsterdam"@nl }',
                Row,
                [ scheme(https),
                  host('query.wikidata.org'),
                  path('/sparql')
                ]).

*/

 sparql_query(+Query, -Result, +Options) is nondet
Execute a SPARQL query on an HTTP SPARQL endpoint. Query is an atom that denotes the query. Result is unified to a term rdf(S,P,O) for CONSTRUCT and DESCRIBE queries, row(...) for SELECT queries and true or false for ASK queries. Options are
host(+Host)
port(+Port)
path(+Path)
scheme(+Scheme)
The above four options set the location of the server.
search(+ListOfParams)
Provide additional query parameters, such as the graph.
variable_names(-ListOfNames)
Unifies ListOfNames with a list of atoms that describe the names of the variables in a 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])
                ]).
  116sparql_query(Query, Row, Options) :-
  117    sparql_param(scheme(Scheme), Options,  Options1),
  118    sparql_port(Scheme, Port,    Options1, Options2),
  119    sparql_param(host(Host),     Options2, Options3),
  120    sparql_param(path(Path),     Options3, Options4),
  121    select_option(search(Extra), Options4, Options5, []),
  122    select_option(variable_names(VarNames), Options5, Options6, _),
  123    sparql_extra_headers(HTTPOptions),
  124    http_open([ scheme(Scheme),
  125                host(Host),
  126                port(Port),
  127                path(Path),
  128                search([ query = Query
  129                       | Extra
  130                       ])
  131              | Options6
  132              ], In,
  133              [ header(content_type, ContentType),
  134                status_code(Status)
  135              | HTTPOptions
  136              ]),
  137    plain_content_type(ContentType, CleanType),
  138    read_reply(Status, CleanType, In, VarNames, Row).
 sparql_extra_headers(-List)
Send extra headers with the request. Note that, although we also process RDF embedded in HTML, we do not explicitely ask for it. Doing so causes some (e.g., http://w3.org/2004/02/skos/core to reply with the HTML description rather than the RDF).
  147sparql_extra_headers(
  148        [ request_header('Accept' = 'application/sparql-results+xml, \c
  149                                     application/n-triples, \c
  150                                     application/x-turtle; q=0.9, \c
  151                                     application/turtle; q=0.9, \c
  152                                     text/turtle, \c
  153                                     application/sparql-results+json, \c
  154                                     application/rdf+xml, \c
  155                                     text/rdf+xml; q=0.8, \c
  156                                     */*; q=0.1'),
  157          cert_verify_hook(ssl_verify)
  158        ]).
  159
  160:- public ssl_verify/5.
 ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
Currently we accept all certificates.
  166ssl_verify(_SSL,
  167           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  168           _Error).
 read_reply(+Status, +ContentType, +In, -Close, -Row)
  172read_reply(200, ContentType, In, Close, Row) :-
  173    !,
  174    read_reply(ContentType, In, Close, Row).
  175read_reply(Status, _ContentType, In, _Close, _Row) :-
  176    call_cleanup(read_string(In, _, Reply),
  177                 close(In, [force(true)])),
  178    throw(error(sparql_error(Status, Reply), _)).
  179
  180read_reply('application/rdf+xml', In, _, Row) :-
  181    !,
  182    call_cleanup(load_rdf(stream(In), RDF), close(In)),
  183    member(Row, RDF).
  184read_reply(MIME, In, _, Row) :-
  185    turtle_media_type(MIME),
  186    !,
  187    call_cleanup(rdf_read_turtle(stream(In), RDF, []), close(In)),
  188    member(Row, RDF).
  189read_reply(MIME, In, VarNames, Row) :-
  190    sparql_result_mime(MIME),
  191    !,
  192    call_cleanup(sparql_read_xml_result(stream(In), Result),
  193                 close(In)),
  194    varnames(Result, VarNames),
  195    xml_result(Result, Row).
  196read_reply(MIME, In, VarNames, Row) :-
  197    json_result_mime(MIME),
  198    !,
  199    call_cleanup(sparql_read_json_result(stream(In), Result),
  200                 close(In)),
  201    (   Result = select(VarNames, Rows)
  202    ->  member(Row, Rows)
  203    ;   Result = ask(True)
  204    ->  Row = True,
  205        VarNames = []
  206    ).
  207read_reply(Type, In, _, _) :-
  208    read_stream_to_codes(In, Codes),
  209    string_codes(Reply, Codes),
  210    close(In),
  211    throw(error(domain_error(sparql_result_document, Type),
  212                context(_, Reply))).
  213
  214turtle_media_type('application/x-turtle').
  215turtle_media_type('application/turtle').
  216turtle_media_type('application/n-triples').
  217turtle_media_type('text/rdf+n3').
  218turtle_media_type('text/turtle').
  219
  220sparql_result_mime('application/sparql-results+xml'). % official
  221sparql_result_mime('application/sparql-result+xml').
  222
  223json_result_mime('application/sparql-results+json').
  224
  225
  226plain_content_type(Type, Plain) :-
  227    sub_atom(Type, B, _, _, (;)),
  228    !,
  229    sub_string(Type, 0, B, _, Main),
  230    normalize_space(atom(Plain), Main).
  231plain_content_type(Type, Type).
  232
  233xml_result(ask(Bool), Result) :-
  234    !,
  235    Result = Bool.
  236xml_result(select(_VarNames, Rows), Result) :-
  237    member(Result, Rows).
  238
  239varnames(ask(_), _).
  240varnames(select(VarTerm, _Rows), VarNames) :-
  241    VarTerm =.. [_|VarNames].
  242
  243
  244                 /*******************************
  245                 *            SETTINGS          *
  246                 *******************************/
  247
  248:- dynamic
  249    sparql_setting/1.  250
  251sparql_setting(scheme(http)).
  252sparql_setting(path('/sparql/')).
  253
  254sparql_param(Param, Options0, Options) :-
  255    select_option(Param, Options0, Options),
  256    !.
  257sparql_param(Param, Options, Options) :-
  258    sparql_setting(Param),
  259    !.
  260sparql_param(Param, Options, Options) :-
  261    functor(Param, Name, _),
  262    throw(error(existence_error(option, Name), _)).
  263
  264sparql_port(_Scheme, Port, Options0, Options) :-
  265    select_option(port(Port), Options0, Options),
  266    !.
  267sparql_port(_Scheme, Port, Options, Options) :-
  268    sparql_setting(port(Port)),
  269    !.
  270sparql_port(http, 80, Options, Options) :-
  271    !.
  272sparql_port(https, 443, Options, Options) :-
  273    !.
 sparql_set_server(+OptionOrList)
Set sparql server default options. Provided defaults are: host, port and repository. For example:
    sparql_set_server([ host(localhost),
                        port(8080)
                        path(world)
                      ])

The default for port is 80 and path is /sparql/.

  290sparql_set_server([]) :- !.
  291sparql_set_server([H|T]) :-
  292    !,
  293    sparql_set_server(H),
  294    sparql_set_server(T).
  295sparql_set_server(Term) :-
  296    functor(Term, Name, Arity),
  297    functor(Unbound, Name, Arity),
  298    retractall(sparql_setting(Unbound)),
  299    assert(sparql_setting(Term)).
  300
  301
  302                 /*******************************
  303                 *             RESULT           *
  304                 *******************************/
  305
  306ns(sparql, 'http://www.w3.org/2005/sparql-results#').
  307
  308/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  309Read    the    SPARQL    XML    result     format    as    defined    in
  310http://www.w3.org/TR/rdf-sparql-XMLres/, version 6 April 2006.
  311- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  312
  313                 /*******************************
  314                 *        MACRO HANDLING        *
  315                 *******************************/
  316
  317%       substitute 'sparql' by the namespace   defined  above for better
  318%       readability of the remainder of the code.
  319
  320term_subst(V, _, _, V) :-
  321    var(V),
  322    !.
  323term_subst(F, F, T, T) :- !.
  324term_subst(C, F, T, C2) :-
  325    compound(C),
  326    !,
  327    functor(C, Name, Arity),
  328    functor(C2, Name, Arity),
  329    term_subst(0, Arity, C, F, T, C2).
  330term_subst(T, _, _, T).
  331
  332term_subst(A, A, _, _, _, _) :- !.
  333term_subst(I0, Arity, C0, F, T, C) :-
  334    I is I0 + 1,
  335    arg(I, C0, A0),
  336    term_subst(A0, F, T, A),
  337    arg(I, C, A),
  338    term_subst(I, Arity, C0, F, T, C).
  339
  340term_expansion(T0, T) :-
  341    ns(sparql, NS),
  342    term_subst(T0, sparql, NS, T).
  343
  344
  345                 /*******************************
  346                 *           READING            *
  347                 *******************************/
 sparql_read_xml_result(+Input, -Result)
Specs from http://www.w3.org/TR/rdf-sparql-XMLres/. The returned Result term is of the format:
select(VarNames, Rows)
Where VarNames is a term v(Name, ...) and Rows is a list of row(....) containing the column values in the same order as the variable names.
ask(Bool)
Where Bool is either true or false
  362:- thread_local
  363    bnode_map/2.  364
  365sparql_read_xml_result(Input, Result) :-
  366    load_structure(Input, DOM,
  367                   [ dialect(xmlns),
  368                     space(remove)
  369                   ]),
  370    call_cleanup(dom_to_result(DOM, Result),
  371                 retractall(bnode_map(_,_))).
  372
  373dom_to_result(DOM, Result) :-
  374    (   sub_element(DOM, sparql:head, _HAtt, Content)
  375    ->  variables(Content, Vars)
  376    ;   Vars = []
  377    ),
  378    (   Vars == [],
  379        sub_element(DOM, sparql:boolean, _, [TrueFalse])
  380    ->  Result = ask(TrueFalse)
  381    ;   VarTerm =.. [v|Vars],
  382        Result = select(VarTerm, Rows),
  383        sub_element(DOM, sparql:results, _RAtt, RContent)
  384    ->  rows(RContent, Vars, Rows)
  385    ),
  386    !.                                   % Guarantee finalization
 variables(+DOM, -Varnames)
Deals with <variable name=Name>. Head also may contain <link href="..."/>. This points to additional meta-data. Not really clear what we can do with that.
  394variables([], []).
  395variables([element(sparql:variable, Att, [])|T0], [Name|T]) :-
  396    !,
  397    memberchk(name=Name, Att),
  398    variables(T0, T).
  399variables([element(sparql:link, _, _)|T0], T) :-
  400    variables(T0, T).
  401
  402
  403rows([], _, []).
  404rows([R|T0], Vars, [Row|T]) :-
  405    row_values(Vars, R, Values),
  406    Row =.. [row|Values],
  407    rows(T0, Vars, T).
  408
  409row_values([], _, []).
  410row_values([Var|VarT], DOM, [Value|ValueT]) :-
  411    (   sub_element(DOM, sparql:binding, Att, Content),
  412        memberchk(name=Var, Att)
  413    ->  value(Content, Value)
  414    ;   Value = '$null$'
  415    ),
  416    row_values(VarT, DOM, ValueT).
  417
  418value([element(sparql:literal, Att, Content)], literal(Lit)) :-
  419    !,
  420    lit_value(Content, Value),
  421    (   memberchk(datatype=Type, Att)
  422    ->  Lit = type(Type, Value)
  423    ;   memberchk(xml:lang=Lang, Att)
  424    ->  Lit = lang(Lang, Value)
  425    ;   Lit = Value
  426    ).
  427value([element(sparql:uri, [], [URI])], URI) :- !.
  428value([element(sparql:bnode, [], [NodeID])], URI) :-
  429    !,
  430    bnode(NodeID, URI).
  431value([element(sparql:unbound, [], [])], '$null$').
  432
  433
  434lit_value([], '').
  435lit_value([Value], Value).
 sub_element(+DOM, +Name, -Atttribs, -Content)
  440sub_element(element(Name, Att, Content), Name, Att, Content).
  441sub_element(element(_, _, List), Name, Att, Content) :-
  442    sub_element(List, Name, Att, Content).
  443sub_element([H|T], Name, Att, Content) :-
  444    (   sub_element(H, Name, Att, Content)
  445    ;   sub_element(T, Name, Att, Content)
  446    ).
  447
  448
  449bnode(Name, URI) :-
  450    bnode_map(Name, URI),
  451    !.
  452bnode(Name, URI) :-
  453    gensym('__bnode', URI0),
  454    assertz(bnode_map(Name, URI0)),
  455    URI = URI0.
 sparql_read_json_result(+Input, -Result) is det
The returned Result term is of the format:
select(VarNames, Rows)
Where VarNames is a term v(Name, ...) and Rows is a list of row(....) containing the column values in the same order as the variable names.
ask(Bool)
Where Bool is either true or false
See also
- http://www.w3.org/TR/rdf-sparql-json-res/
  472sparql_read_json_result(Input, Result) :-
  473    setup_call_cleanup(
  474        open_input(Input, In, Close),
  475        read_json_result(In, Result),
  476        close_input(Close)).
  477
  478open_input(stream(In), In, Close) :-
  479    !,
  480    encoding(In, utf8, Close).
  481open_input(In, In, Close) :-
  482    is_stream(In),
  483    !,
  484    encoding(In, utf8, Close).
  485open_input(File, In, close(In)) :-
  486    open(File, read, In, [encoding(utf8)]).
  487
  488encoding(In, Encoding, Close) :-
  489    stream_property(In, encoding(Old)),
  490    (   Encoding == Old
  491    ->  Close = true
  492    ;   set_stream(In, encoding(Encoding)),
  493        Close = set_stream(In, Encoding, Old)
  494    ).
  495
  496close_input(close(In)) :-
  497    !,
  498    retractall(bnode_map(_,_)),
  499    close(In).
  500close_input(_) :-
  501    retractall(bnode_map(_,_)).
  502
  503read_json_result(In, Result) :-
  504    json_read(In, JSON),
  505    json_to_result(JSON, Result).
  506
  507json_to_result(json([ head    = json(Head),
  508                      results = json(Body)
  509                    ]),
  510               select(Vars, Rows)) :-
  511    memberchk(vars=VarList, Head),
  512    Vars =.. [v|VarList],
  513    memberchk(bindings=Bindings, Body),
  514    !,
  515    maplist(json_row(VarList), Bindings, Rows).
  516json_to_result(json(JSon), ask(Boolean)) :-
  517    memberchk(boolean = @(Boolean), JSon).
  518
  519
  520json_row(Vars, json(Columns), Row) :-
  521    maplist(json_cell, Vars, Columns, Values),
  522    !,
  523    Row =.. [row|Values].
  524json_row(Vars, json(Columns), Row) :-
  525    maplist(json_cell_or_null(Columns), Vars, Values),
  526    Row =.. [row|Values].
  527
  528json_cell(Var, Var=json(JValue), Value) :-
  529    memberchk(type=Type, JValue),
  530    jvalue(Type, JValue, Value).
  531
  532json_cell_or_null(Columns, Var, Value) :-
  533    memberchk(Var=json(JValue), Columns),
  534    !,
  535    memberchk(type=Type, JValue),
  536    jvalue(Type, JValue, Value).
  537json_cell_or_null(_, _, '$null$').
  538
  539jvalue(uri, JValue, URI) :-
  540    memberchk(value=URI, JValue).
  541jvalue(literal, JValue, literal(Literal)) :-
  542    memberchk(value=Value, JValue),
  543    (   memberchk('xml:lang'=Lang, JValue)
  544    ->  Literal = lang(Lang, Value)
  545    ;   memberchk('datatype'=Type, JValue)
  546    ->  Literal = type(Type, Value)
  547    ;   Literal = Value
  548    ).
  549jvalue('typed-literal', JValue, literal(type(Type, Value))) :-
  550    memberchk(value=Value, JValue),
  551    memberchk('datatype'=Type, JValue).
  552jvalue(bnode, JValue, URI) :-
  553    memberchk(value=NodeID, JValue),
  554    bnode(NodeID, URI)