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