[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