Author: lgiessmann Date: Sun Feb 6 05:17:44 2011 New Revision: 390 Log: TM-SPARQL: added a method to process the special uri tms:player Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp trunk/src/model/datamodel.lisp 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 05:17:44 2011 @@ -47,8 +47,7 @@ (filter-for-roles construct :revision revision)) ((and (has-identifier (value pred) *tms-player*) (typep subj-value 'd:RoleC)) - nil) ;TODO: implement - ))))) + (filter-for-player construct :revision revision))))))) (defgeneric filter-for-special-uris (construct &key revision) @@ -66,6 +65,67 @@ )) +(defgeneric filter-for-player (construct &key revision) + (:documentation "Returns a list with triples where the subject + represents a role and the object represents a player.") + (: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 (player (value subj) :revision revision) + (value obj)) + (list (list :subject subj-uri + :predicate pred-uri + :object obj-uri)))) + ((not (variable-p subj)) + (let ((player-top + (player (value subj) :revision revision))) + (when player-top + (list :subject subj-uri + :predicate pred-uri + :object (when-do id (any-id player-top :revision revision) + (embrace-uri (uri id))))))) + ((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)) + :predicate pred-uri + :object + (when-do id (any-id (player role :revision revision) + :revision revision) + (embrace-uri id)))))) + (t ; only pred is given + (let ((all-roles + (remove-null + (map 'list #'(lambda(role) + (when (player role :revision revision) + 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))) + :predicate pred-uri + :object + (when-do id (any-id (player role :revision revision) + :revision revision) + (embrace-uri id))))))))))) + + (defgeneric filter-for-roles (construct &key revision) (:documentation "Returns a list of triples where the subject represents an Association and the object represents a role.") @@ -294,8 +354,8 @@ (defgeneric filter-for-reifier (construct &key revision) - (:documentation "Returns a list with one triple representing a reifier - and the corresponding reified construct.") + (: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)) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Sun Feb 6 05:17:44 2011 @@ -154,6 +154,7 @@ :rec-remf :get-all-topics :get-all-associations + :get-all-roles :get-all-occurrences :get-all-names :get-all-variants @@ -763,6 +764,10 @@ (get-db-instances-by-class 'AssociationC :revision revision)) +(defun get-all-roles (&optional (revision *TM-REVISION*)) + (get-db-instances-by-class 'RoleC :revision revision)) + + (defun get-all-occurrences (&optional (revision *TM-REVISION*)) (get-db-instances-by-class 'OccurrenceC :revision revision))