[isidorus-cvs] r390 - in trunk/src: TM-SPARQL model

[Lukas Giessmann]

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))