Changeset 240 for branches/new-datamodel

Timestamp:

03/21/10 18:15:47 (15 years ago)

Author:

lgiessmann

Message:

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

Location:

branches/new-datamodel/src

Files:

• model/datamodel.lisp (modified) (4 diffs)
• rest_interface/read.lisp (modified) (2 diffs)
• xml/rdf/exporter.lisp (modified) (3 diffs)
• xml/xtm/importer_xtm1.0.lisp (modified) (3 diffs)
• xml/xtm/importer_xtm2.0.lisp (modified) (3 diffs)

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -21 +21 @@
   (:export ;;classes
            :TopicMapConstructC
+           :VersionedConstructC
+           :ReifiableConstructC
            :TopicMapC
            :AssociationC
            :RoleC
+           :CharacteristicC
            :OccurrenceC
            :NameC
            :VariantC
+           :PointerC
+           :IdentifierC
            :PersistentIdC
            :ItemIdentifierC
@@ -125 +130 @@
            :make-construct
            :list-instanceOf
+           :list-super-types
            :in-topicmap
            :string-starts-with
@@ -132 +138 @@
            :unique-id
            :topic
+           :referenced-topics
            :revision
            :get-all-revisions-for-tm
@@ -1592 +1599 @@
 
 
-
-(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))))))
 
 

branches/new-datamodel/src/rest_interface/read.lisp ¶

@@ -68 +68 @@
            ;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))
@@ -99 +99 @@
 
 (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)

branches/new-datamodel/src/xml/rdf/exporter.lisp ¶

@@ -217 +217 @@
   (if (psis topic)
       (cxml:attribute "rdf:resource"
-                      (if (reified topic)
+                      (if (reified-construct topic)
                           (let ((psi (get-reifier-psi topic)))
                             (if psi
@@ -593 +593 @@
           (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
@@ -628 +628 @@
           (sl (locators construct)))
       (if psi
-          (if (reified construct)
+          (if (reified-construct construct)
               (let ((reifier-uri (get-reifier-uri construct)))
                 (if reifier-uri

branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp ¶

@@ -84 +84 @@
                         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"))))
@@ -395 +395 @@
         (create-instanceof-association instanceOf-topicRef top start-revision :xtm-id xtm-id
                                        :tm tm))
-      (add-to-topicmap tm top))))
+      (add-to-tm tm top))))
 
 
@@ -421 +421 @@
         (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

branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp ¶

@@ -314 +314 @@
                                        :tm tm
                                        :xtm-id xtm-id))
-      (add-to-topicmap tm top)
+      (add-to-tm tm top)
       top))))
 
@@ -387 +387 @@
          (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
@@ -416 +416 @@
         ((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