[isidorus-cvs] r12 - in trunk/src: . model unit_tests xml
Marc Wilhelm Kuster
mkuster at common-lisp.net
Sun Feb 1 21:44:18 UTC 2009
Author: mkuster
Date: Sun Feb 1 21:44:18 2009
New Revision: 12
Log:
instanceOf associations are now also filtered by TM
Added:
trunk/src/unit_tests/multiple_tms_ont.xtm
trunk/src/unit_tests/multiple_tms_worms.xtm
Modified:
trunk/src/isidorus.asd
trunk/src/model/datamodel.lisp
trunk/src/xml/exporter.lisp
trunk/src/xml/exporter_xtm1.0.lisp
trunk/src/xml/exporter_xtm2.0.lisp
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Sun Feb 1 21:44:18 2009
@@ -35,7 +35,8 @@
:depends-on ("importer_xtm2.0"
"importer_xtm1.0"))
(:file "exporter_xtm1.0")
- (:file "exporter_xtm2.0")
+ (:file "exporter_xtm2.0"
+ :depends-on ("exporter_xtm1.0"))
(:file "exporter"
:depends-on ("exporter_xtm1.0"
"exporter_xtm2.0")))
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Sun Feb 1 21:44:18 2009
@@ -948,6 +948,10 @@
(:method ((topic TopicC) &key (revision *TM-REVISION*))
(filter-slot-value-by-revision topic 'used-as-theme :start-revision revision)))
+(defgeneric in-topicmaps (topic)
+ (:method ((topic TopicC))
+ (filter-slot-value-by-revision topic 'in-topicmaps :start-revision *TM-REVISION*)))
+
(defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil))
"implement the pseudo-initargs :topic-ids, :persistent-ids, and :subject-locators"
(declare (list psis))
@@ -1135,19 +1139,29 @@
(:documentation "Test for the existence of PSIs")
(:method ((top TopicC)) (slot-predicate top 'psis)))
-(defgeneric list-instanceOf (topic)
- (:method ((topic TopicC))))
-
-(defmethod list-instanceOf ((topic TopicC))
- (remove-if #'null
- (map 'list #'(lambda(x)
- (when (loop for psi in (psis (instance-of x))
- when (string= (uri psi) "http://psi.topicmaps.org/iso13250/model/instance")
- return t)
- (loop for role in (roles (parent x))
- when (not (eq role x))
- return (player role))))
- (player-in-roles topic))))
+(defgeneric list-instanceOf (topic &key tm)
+ (:documentation "Generate 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) "http://psi.topicmaps.org/iso13250/model/instance")
+ return t)
+ (loop for role in (roles (parent x))
+ when (not (eq role x))
+ return (player role))))
+ (if tm
+ (remove-if-not
+ (lambda (role)
+ (format t "player: ~a" (player role))
+ (format t "parent: ~a" (parent role))
+ (format t "topic: ~a~&" topic)
+ (in-topicmap tm (parent role)))
+ (player-in-roles topic))
+ (player-in-roles topic)))))
(defun string-starts-with (str prefix)
"Checks if string str starts with a given prefix"
Added: trunk/src/unit_tests/multiple_tms_ont.xtm
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/multiple_tms_ont.xtm Sun Feb 1 21:44:18 2009
@@ -0,0 +1,57 @@
+<?xml version="1.0" encoding="utf-8"?>
+<topicMap xmlns="http://www.topicmaps.org/xtm/1.0/"
+ xmlns:xlink="http://www.w3.org/1999/xlink">
+ <topic id="t1">
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/types/topic-type"/>
+ </subjectIdentity>
+ </topic>
+
+ <topic id="a1">
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/types/association-type"/>
+ </subjectIdentity>
+ </topic>
+
+ <topic id="r1">
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/types/role-type"/>
+ </subjectIdentity>
+ </topic>
+
+ <topic id="t2">
+ <instanceOf>
+ <topicRef xlink:href="#t1"/>
+ </instanceOf>
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t2"/>
+ </subjectIdentity>
+ </topic>
+
+ <topic id="t3">
+ <instanceOf>
+ <topicRef xlink:href="#t1"/>
+ </instanceOf>
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t3"/>
+ </subjectIdentity>
+ </topic>
+
+ <association>
+ <instanceOf>
+ <topicRef xlink:href="#a2"/>
+ </instanceOf>
+ <member>
+ <roleSpec>
+ <topicRef xlink:href="#r1"/>
+ </roleSpec>
+ <topicRef xlink:href="#t2"/>
+ </member>
+ <member>
+ <roleSpec>
+ <topicRef xlink:href="#r1"/>
+ </roleSpec>
+ <topicRef xlink:href="#t3"/>
+ </member>
+ </association>
+</topicMap>
\ No newline at end of file
Added: trunk/src/unit_tests/multiple_tms_worms.xtm
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/multiple_tms_worms.xtm Sun Feb 1 21:44:18 2009
@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="utf-8"?>
+<topicMap xmlns="http://www.topicmaps.org/xtm/1.0/"
+ xmlns:xlink="http://www.w3.org/1999/xlink">
+
+ <topic id="t2">
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t2"/>
+ </subjectIdentity>
+ </topic>
+
+ <topic id="t3">
+ <subjectIdentity>
+ <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t3"/>
+ </subjectIdentity>
+ </topic>
+</topicMap>
\ No newline at end of file
Modified: trunk/src/xml/exporter.lisp
==============================================================================
--- trunk/src/xml/exporter.lisp (original)
+++ trunk/src/xml/exporter.lisp Sun Feb 1 21:44:18 2009
@@ -1,9 +1,9 @@
(in-package :exporter)
-(defun instanceofs-to-elem (ios)
- (when ios
- (map 'list (lambda (io) (cxml:with-element "t:instanceOf" (ref-to-elem io))) ios)))
+;; (defun instanceofs-to-elem (ios)
+;; (when ios
+;; (map 'list (lambda (io) (cxml:with-element "t:instanceOf" (ref-to-elem io))) ios)))
(defun list-extern-associations ()
@@ -39,15 +39,18 @@
, at body))))
(defmacro export-to-elem (tm to-elem)
- `(map 'list ,to-elem
+ `(setf *export-tm* ,tm)
+ `(format t "*export-tm*: ~a" *export-tm*)
+ `(map 'list
+ ,to-elem
(remove-if
#'null
(map 'list
#'(lambda(top)
(d:find-item-by-revision top revision))
(if ,tm
- (union
- (d:topics ,tm) (d:associations ,tm))
+ (union
+ (d:topics ,tm) (d:associations ,tm))
(union
(elephant:get-instances-by-class 'd:TopicC)
(list-extern-associations)))))))
@@ -60,6 +63,7 @@
((tm
(when tm-id
(get-item-by-item-identifier tm-id :revision revision))))
+ (setf *export-tm* tm)
(with-revision revision
(with-open-file (stream xtm-path :direction :output)
(cxml:with-xml-output (cxml:make-character-stream-sink stream :canonical nil)
Modified: trunk/src/xml/exporter_xtm1.0.lisp
==============================================================================
--- trunk/src/xml/exporter_xtm1.0.lisp (original)
+++ trunk/src/xml/exporter_xtm1.0.lisp Sun Feb 1 21:44:18 2009
@@ -13,6 +13,8 @@
(in-package :exporter)
+(defparameter *export-tm* nil "TopicMap which is exported (nil if all is to be exported")
+
(defgeneric to-elem-xtm1.0 (instance)
(:documentation "converts the Topic Maps construct instance to an XTM 1.0 element"))
@@ -115,8 +117,8 @@
(baseName | occurrence)* }"
(cxml:with-element "t:topic"
(cxml:attribute "id" (topicid topic))
- (when (list-instanceOf topic)
- (map 'list #'to-instanceOf-elem-xtm1.0 (list-instanceOf topic)))
+ (when (list-instanceOf topic :tm *export-tm*)
+ (map 'list #'to-instanceOf-elem-xtm1.0 (list-instanceOf topic :tm *export-tm*)))
(when (or (psis topic) (locators topic))
(to-subjectIdentity-elem-xtm1.0 (psis topic) (first (locators topic))))
(when (names topic)
Modified: trunk/src/xml/exporter_xtm2.0.lisp
==============================================================================
--- trunk/src/xml/exporter_xtm2.0.lisp (original)
+++ trunk/src/xml/exporter_xtm2.0.lisp Sun Feb 1 21:44:18 2009
@@ -118,9 +118,9 @@
(map 'list #'to-elem (item-identifiers topic))
(map 'list #'to-elem (locators topic))
(map 'list #'to-elem (psis topic))
- (when (list-instanceOf topic)
+ (when (list-instanceOf topic :tm *export-tm*)
(cxml:with-element "t:instanceOf"
- (loop for item in (list-instanceOf topic)
+ (loop for item in (list-instanceOf topic :tm *export-tm*)
do (cxml:with-element "t:topicRef"
(cxml:attribute "href" (concatenate 'string "#" (topicid item)))))))
(map 'list #'to-elem (names topic))
More information about the Isidorus-cvs
mailing list