[isidorus-cvs] r240 - in branches/new-datamodel/src: model rest_interface xml/rdf xml/xtm

Lukas Giessmann lgiessmann at common-lisp.net
Sun Mar 21 18:15:48 UTC 2010


Author: lgiessmann
Date: Sun Mar 21 14:15:47 2010
New Revision: 240

Log:
new-datamodel: changed some code sections that caused problems with "rdf_exporter.lisp"

Modified:
   branches/new-datamodel/src/model/datamodel.lisp
   branches/new-datamodel/src/rest_interface/read.lisp
   branches/new-datamodel/src/xml/rdf/exporter.lisp
   branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp
   branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp

Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Sun Mar 21 14:15:47 2010
@@ -20,12 +20,17 @@
 		*instance-psi*)
   (:export ;;classes
            :TopicMapConstructC
+	   :VersionedConstructC
+	   :ReifiableConstructC
            :TopicMapC
            :AssociationC
            :RoleC
+	   :CharacteristicC
            :OccurrenceC
 	   :NameC
 	   :VariantC
+	   :PointerC
+	   :IdentifierC
            :PersistentIdC
 	   :ItemIdentifierC
 	   :SubjectLocatorC
@@ -124,6 +129,7 @@
 	   :VersionedConstructC-p
 	   :make-construct
 	   :list-instanceOf
+	   :list-super-types
 	   :in-topicmap
 	   :string-starts-with
 	   :get-fragments
@@ -131,6 +137,7 @@
 	   :get-all-revisions
 	   :unique-id
 	   :topic
+	   :referenced-topics
 	   :revision
 	   :get-all-revisions-for-tm
 	   :add-source-locator
@@ -1591,28 +1598,56 @@
 			  :error-if-nil error-if-nil))
 
 
-
-(defgeneric list-instanceOf (topic &key tm)
+(defgeneric list-instanceOf (topic &key tm revision)
  (:documentation "Generates a list of all topics that this topic is an
-                  instance of, optionally filtered by a topic map"))
-
-
-(defmethod list-instanceOf ((topic TopicC)  &key (tm nil))
-  (remove-if 
-   #'null
-   (map 'list #'(lambda(x)
-                  (when (loop for psi in (psis (instance-of x))
-                           when (string= (uri psi) constants:*instance-psi*)
-                           return t)
-                    (loop for role in (roles (parent x))
-                       when (not (eq role x))
-                       return (player role))))
-        (if tm
-            (remove-if-not 
-             (lambda (role)
-               (in-topicmap tm (parent role)))
-             (player-in-roles topic))
-            (player-in-roles topic)))))
+                  instance of, optionally filtered by a topic map")
+ (:method ((topic TopicC) &key (tm nil) (revision 0))
+   (declare (type (or null TopicMapC) tm)
+	    (integer revision))
+   (remove-if 
+    #'null
+    (map 'list
+	 #'(lambda(x)
+	     (when (loop for psi in (psis (instance-of x :revision revision)
+					  :revision revision)
+		      when (string= (uri psi) constants:*instance-psi*)
+		      return t)
+	       (loop for role in (roles (parent x :revision revision)
+					:revision revision)
+		  when (not (eq role x))
+		  return (player role :revision revision))))
+	 (if tm
+	     (remove-if-not 
+	      (lambda (role)
+		(in-topicmap tm (parent role :revision revision)))
+	      (player-in-roles topic :revision revision))
+	     (player-in-roles topic :revision revision))))))
+ 
+
+(defgeneric list-super-types (topic &key tm revision)
+ (:documentation "Generate a list of all topics that this topic is an
+  subclass of, optionally filtered by a topic map")
+ (:method ((topic TopicC)  &key (tm nil) (revision 0))
+   (declare (type (or null TopicMapC) tm)
+	    (integer revision))
+   (remove-if 
+    #'null
+    (map 'list
+	 #'(lambda(x)
+	     (when (loop for psi in (psis (instance-of x :revision revision)
+					  :revision revision)
+		      when (string= (uri psi) *subtype-psi*)
+		      return t)
+	       (loop for role in (roles (parent x :revision revision)
+					:revision revision)
+		  when (not (eq role x))
+		  return (player role :revision revision))))
+	 (if tm
+	     (remove-if-not 
+	      (lambda (role)
+		(in-topicmap tm (parent role :revision revision)))
+	      (player-in-roles topic :revision revision))
+	     (player-in-roles topic :revision revision))))))
 
 
 ;;; CharacteristicC

Modified: branches/new-datamodel/src/rest_interface/read.lisp
==============================================================================
--- branches/new-datamodel/src/rest_interface/read.lisp	(original)
+++ branches/new-datamodel/src/rest_interface/read.lisp	Sun Mar 21 14:15:47 2010
@@ -67,7 +67,7 @@
               (source-locator  (source-locator-prefix feed)))
            ;check if xtm-id has already been imported or if the entry is older
            ;than the snapshot feed. If so, don't do it again
-           (unless (or (xtm-id-p xtm-id) (string> (atom:updated entry) (atom:updated imported-snapshot-entry)))
+           (unless (or (string> (atom:updated entry) (atom:updated imported-snapshot-entry)))
              (when top
 	       (mark-as-deleted top :source-locator source-locator :revision revision))
 	     ;(format t "Fragment feed: ~a~&" (link entry))
@@ -98,10 +98,11 @@
     (find most-recent-update entry-list :key #'updated :test #'string=)))
 
 (defun most-recent-imported-snapshot (all-snapshot-entries)
-  (let
-      ((all-imported-entries
-	(remove-if-not #'xtm-id-p all-snapshot-entries :key #'atom:id)))
-    (most-recent-entry all-imported-entries)))
+;  (let
+;      ((all-imported-entries
+;	(remove-if-not #'xtm-id-p all-snapshot-entries :key #'atom:id)))
+;  (most-recent-entry all-imported-entries))
+  (most-recent-entry all-snapshot-entries))
 
 (defun import-snapshots-feed (snapshot-feed-url &key tm-id)
   "checks if we already imported any of this feed's snapshots. If not,

Modified: branches/new-datamodel/src/xml/rdf/exporter.lisp
==============================================================================
--- branches/new-datamodel/src/xml/rdf/exporter.lisp	(original)
+++ branches/new-datamodel/src/xml/rdf/exporter.lisp	Sun Mar 21 14:15:47 2010
@@ -216,7 +216,7 @@
   (declare (TopicC topic))
   (if (psis topic)
       (cxml:attribute "rdf:resource"
-		      (if (reified topic)
+		      (if (reified-construct topic)
 			  (let ((psi (get-reifier-psi topic)))
 			    (if psi
 				(concatenate 'string "#" (get-reifier-uri topic))
@@ -592,7 +592,7 @@
 	  (t-occs (occurrences construct))
 	  (t-assocs (list-rdf-mapped-associations construct)))
       (if psi
-	  (if (reified construct)
+	  (if (reified-construct construct)
 	      (let ((reifier-uri (get-reifier-uri construct)))
 		(if reifier-uri
 		    (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct)))
@@ -627,7 +627,7 @@
 	  (ii (item-identifiers construct))
 	  (sl (locators construct)))
       (if psi
-	  (if (reified construct)
+	  (if (reified-construct construct)
 	      (let ((reifier-uri (get-reifier-uri construct)))
 		(if reifier-uri
 		    (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct)))

Modified: branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp	(original)
+++ branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp	Sun Mar 21 14:15:47 2010
@@ -83,7 +83,7 @@
 		       ((typep parent-construct 'NameC)
 			parent-construct)
 		       ((typep parent-construct 'VariantC)
-			(name parent-construct))
+			(parent parent-construct))
 		       (t
 			(error "from-variant-elem-xtm1.0: parent-construct is neither NameC nor VariantC"))))
 	(reifier-topic (get-reifier-topic-xtm1.0 variant-elem)))
@@ -394,7 +394,7 @@
       (dolist (instanceOf-topicRef instanceOf-topicRefs)
 	(create-instanceof-association instanceOf-topicRef top start-revision :xtm-id xtm-id
                                        :tm tm))
-      (add-to-topicmap tm top))))
+      (add-to-tm tm top))))
 
 
 (defun from-association-elem-xtm1.0 (assoc-elem start-revision &key tm (xtm-id *current-xtm*))
@@ -420,7 +420,7 @@
       (unless type
 	(format t "from-association-elem-xtm1.0: type is missing -> http://www.topicmaps.org/xtm/1.0/core.xtm#association~%")
 	(setf type (get-item-by-id "association" :xtm-id "core.xtm")))
-      (add-to-topicmap tm
+      (add-to-tm tm
 		       (make-construct 'AssociationC
 				       :start-revision start-revision
 				       :instance-of type

Modified: branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp	(original)
+++ branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp	Sun Mar 21 14:15:47 2010
@@ -313,7 +313,7 @@
         (create-instanceof-association topicref top start-revision
                                        :tm tm
                                        :xtm-id xtm-id))
-      (add-to-topicmap tm top)
+      (add-to-tm tm top)
       top))))
 
 
@@ -386,7 +386,7 @@
                 *xtm2.0-ns* "role")))
 	 (reifier-topic (get-reifier-topic assoc-elem)))
       (setf roles (set-standard-role-types roles)); sets standard role types if there are missing some of them
-      (add-to-topicmap
+      (add-to-tm
        tm 
        (make-construct 'AssociationC
 		       :start-revision start-revision
@@ -415,7 +415,7 @@
     (let
         ((topic-vector (get-topic-elems xtm-dom)))
       (loop for top-elem across topic-vector do
-           (add-to-topicmap 
+           (add-to-tm 
             tm  
             (from-topic-elem-to-stub top-elem revision 
                                      :xtm-id xtm-id))))))




More information about the Isidorus-cvs mailing list