source: branches/new-datamodel/src/model/changes.lisp

Last change on this file was 319, checked in by lgiessmann, 14 years ago

new-datamodel: changed "changed-p", so a ReifiableConstructC also changed when an ItemIdentifierC or a reifier was marked-as-deleted one revision ago; a NameC changed also when a variant was marked-as-deleted one revsion ago; a TopicC changed when any identifier or CharacteristicC was marked-as-deleted one revision ago; an AssociationC changed also when a RoleC was marked-as-deleted one revision ago

  • Property svn:eol-style set to native
File size: 16.5 KB
Line 
1;;+-----------------------------------------------------------------------------
2;;+  Isidorus
3;;+  (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann
4;;+
5;;+  Isidorus is freely distributable under the LGPL license.
6;;+  You can find a detailed description in trunk/docs/LGPL-LICENSE.txt.
7;;+-----------------------------------------------------------------------------
8
9
10(in-package :datamodel)
11
12(defun get-all-revisions ()
13  "Returns an ordered set of the start dates of all revisions in the engine"
14  ;TODO: this is a very inefficient implementation... it would equally
15  ;be possible to have a separate object that stored all such
16  ;revisions and only make the search from the latest version that's
17  ;stored their
18  (let ((revision-set))
19    (dolist (vi (elephant:get-instances-by-class 'VersionInfoC))
20      (pushnew (start-revision vi) revision-set))
21    (sort revision-set #'<)))
22
23
24(defun get-all-revisions-for-tm (tm-id)
25  "Returns an ordered set of the start dates of all revisions in the
26engine for this Topic Map"
27  (let*
28      ((tm (get-item-by-item-identifier tm-id :revision 0))
29       (tops-and-assocs (when tm (union (topics tm) (associations tm))))
30       (revision-set nil))
31    (dolist (vi (mapcan #'versions tops-and-assocs))
32      (pushnew (start-revision vi) revision-set))
33    (sort revision-set #'<)))
34
35
36(defgeneric find-all-associations (instance &key revision)
37  (:documentation "Finds all associations for a topic.")
38  (:method ((instance TopicC) &key (revision *TM-REVISION*))
39    (declare (type (or integer null) revision))
40    (remove-duplicates 
41     (map 'list #'(lambda(role)
42                    (parent role :revision revision))
43          (player-in-roles instance :revision revision)))))
44
45
46(defgeneric find-associations (instance &key revision)
47  (:documentation "Finds all associations of this topic except
48                   type-instance-associations.")
49  (:method ((instance TopicC) &key (revision *TM-REVISION*))
50    (declare (type (or integer null) revision))
51    (let ((type-instance-topic
52           (d:identified-construct
53            (elephant:get-instance-by-value
54             'PersistentIdC 'uri *type-instance-psi*))))
55      (remove-if
56       #'(lambda(assoc)
57           (eql (instance-of assoc :revision revision)
58                type-instance-topic))
59       (find-all-associations instance :revision revision)))))
60 
61
62(defgeneric find-referenced-topics (construct &key revision)
63  (:documentation "find all the topics that are references from this construct as type, scope or player, as the case may be"))
64
65
66(defmethod find-referenced-topics ((characteristic CharacteristicC)
67                                   &key (revision *TM-REVISION*))
68  "characteristics are scopable + typable + reifiable"
69  (append
70   (when (reifier characteristic :revision revision)
71     (list (reifier characteristic :revision revision)))
72   (themes characteristic :revision revision)
73   (when (instance-of characteristic :revision revision)
74     (list (instance-of characteristic :revision revision)))
75   (when (and (typep characteristic 'NameC)
76              (variants characteristic :revision revision))
77     (remove-if #'null
78                (loop for var in (variants characteristic :revision revision)
79                   append (find-referenced-topics var :revision revision))))
80   (when  (and (typep characteristic 'OccurrenceC)
81              (> (length (charvalue characteristic)) 0)
82              (eq #\# (elt (charvalue characteristic) 0)))
83     (list (get-item-by-id (subseq (charvalue characteristic)  1)
84                           :revision revision)))))
85
86
87(defmethod find-referenced-topics ((role RoleC)
88                                   &key (revision *TM-REVISION*))
89  (append
90   (when (reifier role :revision revision)
91     (list (reifier role :revision revision)))
92   (list (instance-of role :revision revision))
93   (list (player role :revision revision))))
94
95
96(defmethod find-referenced-topics ((association AssociationC)
97                                   &key (revision *TM-REVISION*))
98  "associations are scopable + typable"
99  (append
100   (when (reifier association :revision revision)
101     (list (reifier association :revision revision)))
102   (list (instance-of association :revision revision))
103   (themes association :revision revision)
104   (mapcan #'(lambda(role)
105               (find-referenced-topics role :revision revision))
106           (roles association :revision revision))))
107 
108
109(defmethod find-referenced-topics ((top TopicC)
110                                   &key (revision *TM-REVISION*))
111  "Part 1b of the eGov-Share spec states:
112# for each topicname in T export a topic stub for each scope topic
113# for each occurrence in T export a topic stub for the occurrence type (if it exists)
114# for each occurrence in T export a topic stub for each scope topic
115# for each association A in which T plays a role export the association
116# for each association A export a topic stub for the association type
117# for each association A export a topic stub for each topic scope topic
118# for each role R in A export a topic stub for the role type and one for the role player UNLESS the role player is T"
119  (remove-duplicates
120   (remove
121    top
122    (append
123     (list-instanceOf top :revision revision)
124     (mapcan #'(lambda(name)
125                 (find-referenced-topics name :revision revision))
126             (names top :revision revision))
127     (mapcan #'(lambda(variant)
128                 (find-referenced-topics variant :revision revision))
129             (mapcan #'variants (names top :revision revision)))
130     (mapcan #'(lambda(occ)
131                 (find-referenced-topics occ :revision revision))
132             (occurrences top :revision revision))
133     (mapcan #'(lambda(assoc)
134                 (find-referenced-topics assoc :revision revision))
135             (find-associations top :revision revision))))))
136   
137
138(defgeneric initial-version-p (version-info)
139  (:documentation "A helper function for changed-p that returns the passed
140                   version-info object if it is the initial version-info object,
141                   i.e. it owns the smallest start-revsion of the
142                   version-construct.")
143  (:method ((version-info VersionInfoC))
144    (unless (find-if #'(lambda(vi)
145                         (< (start-revision vi) (start-revision version-info)))
146                     (versions (versioned-construct version-info)))
147      version-info)))
148
149
150(defgeneric changed-p (construct revision)
151  (:documentation "Has the topic map construct changed in a given revision?
152                   'Changed' can mean:
153    * newly created
154    * deletion of an element
155    * modified through the addition or removal of identifiers
156    * (for associations) modified through the addition or removal of
157       identifiers in the association or one of its roles
158    * (for topics) modified through the addition or removal of identifiers
159       or characteristics
160    * (for topics) modified through the addition or removal of an association
161       in which it is first player"))
162
163
164(defmethod changed-p ((construct TopicMapConstructC) (revision integer))
165  "changed-p returns nil for TopicMapConstructCs that are not specified
166   more detailed. The actual algorithm is processed for all
167   VersionedConstructCs."
168  (declare (ignorable revision))
169  nil)
170
171
172(defmethod changed-p ((construct PointerC) (revision integer))
173  "Returns t if the PointerC was added to a construct the first
174   time in the passed revision"
175  (let ((version-info (some #'(lambda(pointer-association)
176                                (changed-p pointer-association revision))
177                            (slot-p construct 'identified-construct))))
178    (when version-info
179      (initial-version-p version-info))))
180
181
182(defmethod changed-p ((construct VersionedConstructC) (revision integer))
183  "changed-p returns t if there exist a VersionInfoC with the given start-revision."
184  (let ((version-info
185         (find revision (versions construct) :test #'= :key #'start-revision)))
186    (when version-info
187      (initial-version-p version-info))))
188
189
190(defmethod changed-p ((construct CharacteristicC) (revision integer))
191  "Returns t if the CharacteristicC was added to a construct in the passed
192   revision or if <ReifiableConstructC> changed."
193  (or (call-next-method)
194      (let ((version-info
195             (some #'(lambda(characteristic-association)
196                       (changed-p characteristic-association revision))
197                   (slot-p construct 'parent))))
198        (when version-info
199          (initial-version-p version-info)))))
200
201
202(defmethod changed-p ((construct RoleC) (revision integer))
203  "Returns t if the RoleC was added to a construct in the passed
204   revision or if <ReifiableConstructC> changed."
205  (or (call-next-method)
206      (let ((version-info
207             (some #'(lambda(role-association)
208                       (changed-p role-association revision))
209                   (slot-p construct 'parent))))
210        (when version-info
211          (initial-version-p version-info)))))
212
213
214(defgeneric end-revision-p (construct revision)
215  (:documentation "A helper function for changed-p. It returns the latest
216                   version-info if the passed versioned-construct was
217                   marked-as-deleted in the version that is given.")
218  (:method ((construct VersionedConstructC) (revision integer))
219    (let ((version-info (find revision (versions construct)
220                              :key #'end-revision :test #'=)))
221      (when (and version-info
222                 (not
223                  (find-if
224                   #'(lambda(vi)
225                       (or (> (end-revision vi) (end-revision version-info))
226                           (= (end-revision vi) 0)))
227                   (versions construct))))
228        version-info))))
229
230
231(defmethod changed-p ((construct ReifiableConstructC) (revision integer))
232  "Returns t if a ReifiableConstructC changed in the given version, i.e.
233   an item-identifier or reifier was added to the construct itself."
234  (or (some #'(lambda(vc)
235                (changed-p vc revision))
236            (union (item-identifiers construct :revision revision)
237                   (let ((reifier-top (reifier construct :revision revision)))
238                     (when reifier-top
239                       (list reifier-top)))))
240      (some #'(lambda(vc)
241                (end-revision-p vc revision))
242            (union (slot-p construct 'item-identifiers)
243                   (slot-p construct 'reifier)))))
244
245
246(defmethod changed-p ((construct NameC) (revision integer))
247  "Returns t if the passed NameC changed in the given version, i.e.
248   the <ReifiableConstructC> characteristics or the variants changed."
249  (or (call-next-method)
250      (some #'(lambda(var)
251                (changed-p var revision))
252            (variants construct :revision revision))
253      (some #'(lambda(vc)
254                (end-revision-p vc revision))
255            (slot-p construct 'variants))))
256
257
258(defmethod changed-p ((construct TopicC) (revision integer))
259  "Returns t if the passed TopicC changed in the given version, i.e.
260   the <ReifiableConstructC>, <PersistentIdC>, <LocatorC>, <NameC>,
261   <OccurrenceC>, <AssociationC> or the reified-construct changed."
262  (or (call-next-method)
263      (some #'(lambda(vc)
264                (changed-p vc revision))
265            (union
266             (union
267              (union (psis construct :revision revision)
268                     (locators construct :revision revision))
269              (union (names construct :revision revision)
270                     (occurrences construct :revision revision)))
271             (remove-if-not
272              (lambda (assoc)
273                (eq (player (first (roles assoc :revision revision))
274                            :revision revision)
275                    construct))
276              (find-all-associations construct :revision revision))))
277      (let ((rc (reified-construct construct :revision revision)))
278        (when rc
279          (let ((ra (find-if #'(lambda(reifier-assoc)
280                                 (eql (reifiable-construct reifier-assoc) rc))
281                             (slot-p construct 'reified-construct))))
282            (changed-p ra revision))))
283      (some #'(lambda(vc)
284                (end-revision-p vc revision))
285            (union (union (union (slot-p construct 'psis)
286                                 (slot-p construct 'locators))
287                          (union (slot-p construct 'names)
288                                 (slot-p construct 'occurrences)))
289                   (slot-p construct 'reified-construct)))))
290           
291
292
293(defmethod changed-p ((construct AssociationC) (revision integer))
294  "Returns t if the passed AssociationC changed in the given version, i.e.
295   the <RoleC> or the <ReifiableConstructC> changed."
296  (or (call-next-method)
297      (some #'(lambda(role)
298                (changed-p role revision))
299            (roles construct :revision revision))
300      (some #'(lambda(vc)
301                (end-revision-p vc revision))
302            (slot-p construct 'roles))))
303
304
305(defpclass FragmentC ()
306  ((revision :type integer
307             :initarg :revision
308             :accessor revision
309             :index t
310             :documentation "revision in question")
311   (unique-id :initarg :unique-id
312              :accessor unique-id
313              :index t
314              :documentation "a unique id for this fragment. for now
315              just its OID, but may become a true UUID in the future")
316   (topic :type TopicC
317          :initarg :topic
318          :accessor topic
319          :index t
320          :documentation "changed topic (topicSI in Atom")
321   (referenced-topics
322    :type list
323    :initarg :referenced-topics
324    :accessor referenced-topics
325    :documentation "list of topics that this topic references somehow (through associations, types, scopes in the characteristics etc.")
326   (associations
327    :type list
328    :initarg :associations
329    :accessor associations
330    :documentation "list of association that this topic is a player in")))
331
332(defmethod initialize-instance :after ((fragment FragmentC) &key)
333  "initialze the unique id of the fragment ot some suitable value"
334  (setf (slot-value fragment 'unique-id) (elephant::oid fragment)))
335
336
337(defun get-fragments (revision)
338  "Gets the list of all fragments for a given revision. Returns a
339list of FragmentC objects"
340  (declare (integer revision))
341  (let
342      ((cached-fragments
343        (elephant:get-instances-by-value 'FragmentC
344                                         'revision
345                                         revision)))
346    (if cached-fragments
347        cached-fragments
348        (remove 
349         nil 
350         (map
351          'list 
352          (lambda (top)
353            (when (changed-p top revision)
354              (make-instance 'FragmentC
355                             :revision revision
356                             :associations (find-associations
357                                            top :revision revision)
358                                        ;TODO: this quite probably introduces
359                                        ;code duplication with query: Check!
360                             :referenced-topics (find-referenced-topics
361                                                 top :revision revision)
362                             :topic top)))
363          (get-all-topics revision))))))
364
365(defun get-fragment (unique-id)
366  "get a fragment by its unique id"
367  (declare (integer unique-id))
368  (elephant:get-instance-by-value 'FragmentC 
369                                  'unique-id
370                                  unique-id))
371
372(defgeneric add-source-locator (construct &key source-locator revision)
373  (:documentation "adds an item identifier to a given construct based on the source
374                   locator and an internally generated id (ideally a uuid)"))
375
376
377(defmethod add-source-locator ((construct ReifiableConstructC) &key source-locator revision)
378  (declare (integer revision))
379  (unless
380      (some (lambda (ii)
381              (string-starts-with (uri ii) source-locator))
382            (item-identifiers construct :revision revision))
383    (let
384        ((ii-uri (format nil "~a/~d" source-locator (internal-id construct))))
385      (make-construct 'ItemIdentifierC
386                      :uri ii-uri
387                      :identified-construct construct
388                      :start-revision revision))))
389
390
391(defmethod add-source-locator ((top TopicC) &key source-locator revision)
392  ;topics already have the source locator in (at least) one PSI, so we
393  ;do not need to add an extra item identifier to them. However, we
394  ;need to do that for all their characteristics + associations
395  (mapc (lambda (name)
396          (add-source-locator name :revision revision
397                              :source-locator source-locator))
398        (names top :revision revision))
399  (mapc (lambda (occ)
400          (add-source-locator occ :revision revision
401                              :source-locator source-locator))
402        (occurrences top :revision revision))
403  (mapc (lambda (ass)
404          (add-source-locator ass :revision revision
405                              :source-locator source-locator))
406        (find-associations top :revision revision)))
407
408
409(defun create-latest-fragment-of-topic (topic-psi)
410  "Returns the latest fragment of the passed topic-psi"
411  (declare (string topic-psi))
412  (let ((topic (get-latest-topic-by-psi topic-psi)))
413    (when topic
414      (let ((start-revision
415             (start-revision
416              (find-if #'(lambda(x)
417                           (when (= 0 (end-revision x))
418                             t))
419                       (versions topic)))))
420        (let ((existing-fragment
421               (find-if #'(lambda(x)
422                            (when (eq topic (topic x))
423                              t))
424                        (get-fragments start-revision))))
425          (if existing-fragment
426              existing-fragment
427              (make-instance 'FragmentC
428                             :revision start-revision
429                             :associations (find-associations
430                                            topic :revision start-revision)
431                             :referenced-topics (find-referenced-topics
432                                                 topic :revision start-revision)
433                             :topic topic)))))))
434
435
436(defun get-latest-fragment-of-topic (topic-psi)
437  "Returns the latest existing fragment of the passed topic-psi."
438  (declare (string topic-psi))
439  (let ((topic (get-latest-topic-by-psi topic-psi)))
440    (when topic
441      (let ((existing-fragments
442             (elephant:get-instances-by-value 'FragmentC 'topic topic)))
443        (when existing-fragments
444          (first (sort existing-fragments
445                       #'(lambda(frg-1 frg-2)
446                           (> (revision frg-1) (revision frg-2))))))))))
Note: See TracBrowser for help on using the repository browser.