Author: lgiessmann Date: Sun Feb 6 17:33:55 2011 New Revision: 392 Log: TM-SPARQL: added the ability to handle blank nodes, i.e. tm-items without any identifier Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_special_uris.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Sun Feb 6 17:33:55 2011 @@ -25,6 +25,20 @@ classes and equality operators.") + +(defgeneric sparql-node (construct &key revision) + (:documentation "Returns a string of the form <uri> or _t123 that represents + a resource node or a blank node.") + (:method ((construct TopicMapConstructC) &key (revision d:*TM-REVISION*)) + (declare (Integer revision)) + (let ((uri-string (any-id construct :revision revision))) + (if uri-string + (concat "<" uri-string ">") + (let ((oid-string (write-to-string (elephant::oid construct))) + (pref (subseq (symbol-name (type-of construct)) 0 1))) + (concat "_" (string-downcase pref) oid-string)))))) + + (defun init-tm-sparql (&optional (revision (get-revision))) "Imports the file tmsparql_core_psis.xtm. core_psis.xtm has to be imported before." @@ -470,14 +484,6 @@ results))))) -(defun embrace-uri(uri-string) - "Returns '<'uri-string'>' if uri-string is not a string uri-string - is returned as result." - (if (typep uri-string 'String) - (concat "<" uri-string ">") - uri-string)) - - (defgeneric filter-by-given-object (construct &key revision) (:documentation "Returns a list representing a triple that is the result of a given object.") @@ -555,15 +561,16 @@ (String literal-datatype)) (remove-null (map 'list #'(lambda(char) - (let ((subj (when-do top (parent char :revision revision) - (any-id top :revision revision))) - (pred (when-do top (instance-of char :revision revision) - (any-id top :revision revision)))) - (when (and subj pred) - (list :subject (embrace-uri subj) - :predicate (embrace-uri pred) - :object (charvalue char) - :literal-datatype literal-datatype)))) + (let ((subj-uri + (when-do top (parent char :revision revision) + (sparql-node top :revision revision))) + (pred-uri + (when-do top (instance-of char :revision revision) + (sparql-node top :revision revision)))) + (list :subject subj-uri + :predicate pred-uri + :object (charvalue char) + :literal-datatype literal-datatype))) (remove-if #'(lambda(char) (typep char 'VariantC)) (return-characteristics literal-value literal-datatype))))) @@ -576,26 +583,23 @@ (:method ((construct TopicC) &key (revision *TM-REVISION*)) (declare (Integer revision)) (let ((roles-by-oplayer (player-in-roles construct :revision revision)) - (obj-uri (any-id construct :revision revision))) + (obj-uri (sparql-node construct :revision revision))) (remove-null (map 'list #'(lambda(role) - (let* ((orole - (when-do assoc (parent role :revision revision) - (when (= (length (roles assoc :revision revision)) - 2) - (find-if #'(lambda(r) (not (eql r role))) - (roles assoc :revision revision))))) - (pred-uri - (when-do type (instance-of role :revision revision) - (any-id type :revision revision))) - (subj-uri + (let ((orole + (when-do assoc (parent role :revision revision) + (when (= (length (roles assoc :revision revision)) + 2) + (find-if #'(lambda(r) (not (eql r role))) + (roles assoc :revision revision)))))) + (list :subject (when-do plr (player orole :revision revision) - (any-id plr :revision revision)))) - (when (and obj-uri pred-uri subj-uri) - (list :subject (embrace-uri subj-uri) - :predicate (embrace-uri pred-uri) - :object (embrace-uri obj-uri))))) + (sparql-node plr :revision revision)) + :predicate + (when-do type (instance-of role :revision revision) + (sparql-node type :revision revision)) + :object obj-uri))) roles-by-oplayer))))) @@ -639,29 +643,27 @@ (value (object construct))) role)) roles-by-type)) - roles-by-type)) - (pred-uri (any-id (value (predicate construct)) :revision revision))) + roles-by-type))) (remove-null (map 'list #'(lambda(role) - (let* ((obj-uri - (when-do plr-top (player role :revision revision) - (any-id plr-top :revision revision))) - (assoc (parent role :revision revision)) + (let* ((assoc (parent role :revision revision)) (orole (when (and assoc (= (length (roles assoc :revision revision)) 2)) (find-if #'(lambda(r) (not (eql r role))) - (roles assoc :revision revision)))) - (subj-uri + (roles assoc :revision revision))))) + (list :subject (when-do plr (player orole :revision revision) - (any-id plr :revision revision)))) - (when (and subj-uri pred-uri obj-uri) - (list :subject (embrace-uri subj-uri) - :predicate (embrace-uri pred-uri) - :object (embrace-uri obj-uri))))) + (sparql-node plr :revision revision)) + :predicate + (sparql-node (value (predicate construct)) + :revision revision) + :object + (when-do plr-top (player role :revision revision) + (sparql-node plr-top :revision revision))))) roles-by-player)))))) @@ -700,17 +702,14 @@ (remove-null (map 'list #'(lambda(name) - (let ((subj - (when-do top (parent name :revision revision) - (any-id top :revision revision))) - (pred - (when-do top (instance-of name :revision revision) - (any-id top :revision revision)))) - (when (and subj pred) - (list :subject (embrace-uri subj) - :predicate (embrace-uri pred) - :object (charvalue name) - :literal-datatype *xml-string*)))) + (list :subject + (when-do top (parent name :revision revision) + (sparql-node top :revision revision)) + :predicate + (when-do top (instance-of name :revision revision) + (sparql-node top :revision revision)) + :object (charvalue name) + :literal-datatype *xml-string*)) names-by-literal)))))) @@ -740,17 +739,14 @@ (remove-null (map 'list #'(lambda(occ) - (let ((subj - (when-do top (parent occ :revision revision) - (any-id top :revision revision))) - (pred - (when-do top (instance-of occ :revision revision) - (any-id top :revision revision)))) - (when (and subj pred) - (list :subject (embrace-uri subj) - :predicate (embrace-uri pred) - :object (charvalue occ) - :literal-datatype (datatype occ))))) + (list :subject + (when-do top (parent occ :revision revision) + (sparql-node top :revision revision)) + :predicate + (when-do top (instance-of occ :revision revision) + (sparql-node top :revision revision)) + :object (charvalue occ) + :literal-datatype (datatype occ))) all-occs)))))) @@ -895,19 +891,16 @@ #'(lambda(occ) (filter-occ-by-value occ literal-value literal-datatype)) occs-by-type))) - (subj-uri (when-do top-uri (any-id construct :revision revision) - top-uri))) + (subj-uri (sparql-node construct :revision revision))) (remove-null (map 'list #'(lambda(occ) - (let ((pred-uri - (when-do type-top - (instance-of occ :revision revision) - (any-id type-top :revision revision)))) - (when pred-uri - (list :subject (embrace-uri subj-uri) - :predicate (embrace-uri pred-uri) - :object (charvalue occ) - :literal-datatype (datatype occ))))) + (list :subject subj-uri + :predicate + (when-do type-top + (instance-of occ :revision revision) + (sparql-node type-top :revision revision)) + :object (charvalue occ) + :literal-datatype (datatype occ))) all-occs))))) @@ -930,17 +923,15 @@ :revision revision) (names construct :revision revision))) (all-names (intersection by-type by-literal)) - (subj-uri (any-id construct :revision revision))) + (subj-uri (sparql-node construct :revision revision))) (remove-null (map 'list #'(lambda(name) - (let ((pred-uri - (when-do type-top (instance-of name :revision revision) - (any-id type-top :revision revision)))) - (when pred-uri - (list :subject (embrace-uri subj-uri) - :predicate (embrace-uri pred-uri) - :object (charvalue name) - :literal-datatype *xml-string*)))) + (list :subject subj-uri + :predicate + (when-do type-top (instance-of name :revision revision) + (sparql-node type-top :revision revision)) + :object (charvalue name) + :literal-datatype *xml-string*)) all-names))))) @@ -975,7 +966,7 @@ (let ((assocs (associations-of construct nil nil type-top player-top :revision revision)) - (subj-uri (any-id construct :revision revision))) + (subj-uri (sparql-node construct :revision revision))) (remove-null ;only assocs with two roles can match! (map 'list #'(lambda(assoc) @@ -995,17 +986,16 @@ (when-do type-top (instance-of other-role :revision revision) - (any-id type-top :revision revision)))) + (sparql-node type-top :revision revision)))) (obj-uri (when other-role (when-do player-top (player other-role :revision revision) - (any-id player-top :revision revision))))) - (when (and pred-uri obj-uri) - (list :subject (embrace-uri subj-uri) - :predicate (embrace-uri pred-uri) - :object (embrace-uri obj-uri)))))) + (sparql-node player-top :revision revision))))) + (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) assocs))))) Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original) +++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 17:33:55 2011 @@ -12,11 +12,6 @@ ;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ... -;TODO: change (embrace-uri String) to (embrace-construct TopicMapsConstructC) -; that creates a blank node when there is no identifier available -; => change also any-id, so if there is no identifier a blank node -; have to be returned -; => change all when-do statements that call any-id @@ -99,14 +94,11 @@ (pred (predicate construct)) (obj (object construct)) (subj-uri (unless (variable-p subj) - (when-do id (any-id (value subj) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value subj) :revision revision))) (pred-uri (unless (variable-p pred) - (when-do id (any-id (value pred) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value pred) :revision revision))) (obj-uri (unless (variable-p obj) - (when-do id (any-id (value obj) :revision revision) - (embrace-uri (uri id)))))) + (sparql-node (value obj) :revision revision)))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) (when (eql (player (value subj) :revision revision) @@ -120,19 +112,15 @@ (when player-top (list :subject subj-uri :predicate pred-uri - :object (when-do id (any-id player-top :revision revision) - (embrace-uri (uri id))))))) + :object (sparql-node player-top :revision revision))))) ((not (variable-p obj)) (let ((parent-roles (player-in-roles (value obj) :revision revision))) (loop for role in parent-roles - collect (list :subject (when-do id (any-id role :revision revision) - (embrace-uri id)) + collect (list :subject (sparql-node role :revision revision) :predicate pred-uri - :object - (when-do id (any-id (player role :revision revision) - :revision revision) - (embrace-uri id)))))) + :object (sparql-node (player role :revision revision) + :revision revision))))) (t ; only pred is given (let ((all-roles (remove-null @@ -141,14 +129,10 @@ role)) (get-all-roles revision))))) (loop for role in all-roles - collect (list :subject - (when-do id (any-id role :revision revision) - (embrace-uri (uri id))) + collect (list :subject (sparql-node role :revision revision) :predicate pred-uri - :object - (when-do id (any-id (player role :revision revision) - :revision revision) - (embrace-uri id))))))))))) + :object (sparql-node (player role :revision revision) + :revision revision)))))))))) (defgeneric filter-for-roles (construct &key revision) @@ -160,14 +144,11 @@ (pred (predicate construct)) (obj (object construct)) (subj-uri (unless (variable-p subj) - (when-do id (any-id (value subj) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value subj) :revision revision))) (pred-uri (unless (variable-p pred) - (when-do id (any-id (value pred) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value pred) :revision revision))) (obj-uri (unless (variable-p obj) - (when-do id (any-id (value obj) :revision revision) - (embrace-uri (uri id)))))) + (sparql-node (value obj) :revision revision)))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) (when (find obj (roles (value subj) :revision revision)) @@ -178,13 +159,11 @@ (loop for role in (roles (value subj) :revision revision) collect (list :subject subj-uri :predicate pred-uri - :object (when-do id (any-id role :revision revision) - (embrace-uri id))))) + :object (sparql-node role :revision revision)))) ((not (variable-p obj)) (let ((parent-assoc (parent (value obj) :revision revision))) (when revision - (list :subject (when-do id (any-id parent-assoc :revision revision) - (embrace-uri id)) + (list :subject (sparql-node parent-assoc :revision revision) :predicate pred-uri :object obj-uri)))) (t ; only pred is given @@ -196,15 +175,11 @@ (get-all-associations revision))))) (loop for assoc in assocs append (loop for role in (roles assoc :revision revision) - collect (list :subject - (when-do id (any-id assoc - :revision revision) - (embrace-uri id)) + collect (list :subject (sparql-node + assoc :revision revision) :predicate pred-uri - :object - (when-do id (any-id role - :revision revision) - (embrace-uri id)))))))))))) + :object (sparql-node + role :revision revision))))))))))) (defgeneric filter-for-topicProperties (construct &key revision) @@ -216,14 +191,11 @@ (pred (predicate construct)) (obj (object construct)) (subj-uri (unless (variable-p subj) - (when-do id (any-id (value subj) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value subj) :revision revision))) (pred-uri (unless (variable-p pred) - (when-do id (any-id (value pred) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value pred) :revision revision))) (obj-uri (unless (variable-p obj) - (when-do id (any-id (value obj) :revision revision) - (embrace-uri (uri id)))))) + (sparql-node (value obj) :revision revision)))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) (when (find obj (append (names (value subj) :revision revision) @@ -237,13 +209,12 @@ (occurrences (value subj) :revision revision)) collect (list :subject subj-uri :predicate pred-uri - :object (when-do id (any-id property :revision revision) - (embrace-uri id))))) + :object + (sparql-node property :revision revision)))) ((not (variable-p obj)) (let ((parent-top (parent (value obj) :revision revision))) (when revision - (list :subject (when-do id (any-id parent-top :revision revision) - (embrace-uri id)) + (list :subject (sparql-node parent-top :revision revision) :predicate pred-uri :object obj-uri)))) (t ; only pred is given @@ -259,13 +230,11 @@ append (loop for prop in (append (names top :revision revision) (occurrences top :revision revision)) - collect (list :subject - (when-do id (any-id top :revision revision) - (embrace-uri id)) + collect (list :subject (sparql-node + top :revision revision) :predicate pred-uri - :object - (when-do id (any-id prop :revision revision) - (embrace-uri id)))))))))))) + :object (sparql-node + prop :revision revision))))))))))) (defgeneric filter-for-values (construct &key revision) @@ -280,11 +249,9 @@ (obj (object construct)) (literal-datatype (literal-datatype obj)) (subj-uri (unless (variable-p subj) - (when-do id (any-id (value subj) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value subj) :revision revision))) (pred-uri (unless (variable-p pred) - (when-do id (any-id (value pred) :revision revision) - (embrace-uri (uri id)))))) + (sparql-node(value pred) :revision revision)))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) (when (or (and (typep subj 'NameC) @@ -302,8 +269,7 @@ :literal-datatype (datatype subj)))) ((not (variable-p obj)) (loop for char in (return-characteristics (value obj) literal-datatype) - collect (list :subject (when-do id (any-id char :revision revision) - (embrace-uri id)) + collect (list :subject (sparql-node char :revision revision) :predicate pred-uri :object (charvalue char) :literal-datatype (datatype char)))) @@ -312,8 +278,7 @@ (get-all-occurrences revision) (get-all-variants revision)))) (loop for char in chars - collect (list :subject (when-do id (any-id char :revision revision) - (embrace-uri id)) + collect (list :subject (sparql-node char :revision revision) :predicate pred-uri :object (charvalue char) :literal-datatype (datatype char)))))))))) @@ -328,14 +293,11 @@ (pred (predicate construct)) (obj (object construct)) (subj-uri (unless (variable-p subj) - (when-do id (any-id (value subj) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value subj) :revision revision))) (pred-uri (unless (variable-p pred) - (when-do id (any-id (value pred) :revision revision) - (embrace-uri (uri id))))) + (sparql-node (value pred) :revision revision))) (obj-uri (unless (variable-p obj) - (when-do id (any-id (value obj) :revision revision) - (embrace-uri (uri id)))))) + (sparql-node (value obj) :revision revision)))) (cond ((and (not (variable-p subj)) (not (variable-p obj))) (when (find obj (themes (value subj) :revision revision)) @@ -346,14 +308,12 @@ (loop for scope in (themes (value subj) :revision revision) collect (list :subject subj-uri :predicate pred-uri - :object (when-do id (any-id scope :revision revision) - (embrace-uri (uri id)))))) + :object (sparql-node scope :revision revision)))) ((not (variable-p obj)) (let ((scoped-constructs (used-as-theme (value obj) :revision revision))) (loop for construct in scoped-constructs - collect (list :subject (when-do id (any-id construct :revision revision) - (embrace-uri (uri id))) + collect (list :subject (sparql-node construct :revision revision) :predicate pred-uri :object obj-uri)))) (t ;only pred is given @@ -369,68 +329,59 @@ (loop for construct in scoped-constructs append (loop for scope in (themes construct :revision revision) collect - (list :subject (when-do id (any-id construct - :revision revision) - (embrace-uri id)) + (list :subject (sparql-node + construct :revision revision) :predicate pred-uri - :object (when-do id (any-id construct - :revision revision) - (embrace-uri id)))))))))))) + :object (sparql-node + construct :revision revision))))))))))) - (defgeneric filter-for-reifier (construct &key revision) - (:documentation "Returns a list with triples representing a reifier +(defgeneric filter-for-reifier (construct &key revision) + (:documentation "Returns a list with triples representing a reifier and the corresponding reified construct.") - (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) - (unless (literal-p (object construct)) - (let* ((subj (subject construct)) - (pred (predicate construct)) - (obj (object construct)) - (subj-uri (unless (variable-p subj) - (when-do id (any-id (value subj) :revision revision) - (embrace-uri (uri id))))) - (pred-uri (unless (variable-p pred) - (when-do id (any-id (value pred) :revision revision) - (embrace-uri (uri id))))) - (obj-uri (unless (variable-p obj) - (when-do id (any-id (value obj) :revision revision) - (embrace-uri (uri id)))))) - (cond ((and (not (variable-p subj)) - (not (variable-p obj))) - (when (eql (reifier (value subj) :revision revision) - (value obj)) - (list (list :subject subj-uri + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (unless (literal-p (object construct)) + (let* ((subj (subject construct)) + (pred (predicate construct)) + (obj (object construct)) + (subj-uri (unless (variable-p subj) + (sparql-node (value subj) :revision revision))) + (pred-uri (unless (variable-p pred) + (sparql-node (value pred) :revision revision))) + (obj-uri (unless (variable-p obj) + (sparql-node (value obj) :revision revision)))) + (cond ((and (not (variable-p subj)) + (not (variable-p obj))) + (when (eql (reifier (value subj) :revision revision) + (value obj)) + (list (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) + ((not (variable-p subj)) + (let ((reifier-top + (reifier (value subj) :revision revision))) + (when reifier-top + (list :subject subj-uri + :predicate pred-uri + :object (sparql-node reifier-top :revision revision))))) + ((not (variable-p obj)) + (let ((reified-cons + (reified-construct (value obj) :revision revision))) + (when reified-cons + (list (list :subject + (sparql-node reified-cons :revision revision) :predicate pred-uri - :object obj-uri)))) - ((not (variable-p subj)) - (let ((reifier-top - (reifier (value subj) :revision revision))) - (when reifier-top - (list :subject subj-uri - :predicate pred-uri - :object (when-do id (any-id reifier-top :revision revision) - (embrace-uri (uri id))))))) - ((not (variable-p obj)) - (let ((reified-cons - (reified-construct (value obj) :revision revision))) - (when reified-cons - (list (list :subject - (when-do id (any-id reified-cons :revision revision) - (embrace-uri (uri id))) - :predicate pred-uri - :object obj-uri))))) - (t ; only pred is given - (let ((topics - (remove-null - (map 'list #'(lambda(top) - (when (reified-construct top :revision revision) - top)) - (get-all-topics revision))))) - (loop for top in topics - collect (list :subject - (when-do id (any-id (reified-construct - top :revision revision)) - (embrace-uri (uri id))) - :predicate pred-uri - :object (when-do id (any-id top :revision revision) - (embrace-uri (uri id)))))))))))) \ No newline at end of file + :object obj-uri))))) + (t ; only pred is given + (let ((topics + (remove-null + (map 'list #'(lambda(top) + (when (reified-construct top :revision revision) + top)) + (get-all-topics revision))))) + (loop for top in topics + collect (list :subject + (sparql-node (reified-construct top :revision revision) + :revision revision) + :predicate pred-uri + :object (sparql-node top :revision revision)))))))))) \ No newline at end of file