source: branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp

Last change on this file was 904, checked in by lgiessmann, 13 years ago

gdl-interface: fixed a bug when updated fragments after commit/delete operations
File size: 14.1 KB
Line 
1;;+-----------------------------------------------------------------------------
2;;+  Isidorus
3;;+  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
4;;+
5;;+  Isidorus is freely distributable under the LLGPL license.
6;;+  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
7;;+  trunk/docs/LGPL-LICENSE.txt.
8;;+-----------------------------------------------------------------------------
9
10(defpackage :jtm-delete-interface
11  (:use :cl :datamodel :jtm)
12  (:export :mark-as-deleted-from-jtm))
13
14(in-package :jtm-delete-interface)
15
16(defun mark-as-deleted-from-jtm (jtm-data &key (revision *TM-REVISION*))
17  "Marks an object that is specified by the given JSON data as deleted."
18  (declare (string jtm-data) (integer revision))
19  (let ((json-list (json:decode-json-from-string jtm-data)))
20    (let ((type nil)
21          (parent nil)
22          (parent-of-parent nil)
23          (delete nil))
24      (loop for json-entry in json-list
25         do (let ((st (car json-entry))
26                  (nd (cdr json-entry)))
27              (cond ((eql st :type)
28                     (setf type nd))
29                    ((eql st :delete)
30                     (setf delete nd))
31                    ((eql st :parent)
32                     (setf parent nd))
33                    ((eql st :parent-of-parent)
34                     (setf parent-of-parent nd)))))
35      (cond ((string= type "Topic")
36             (delete-topic-from-jtm delete :revision revision))
37            ((string= type "PSI")
38             (delete-identifier-from-jtm delete 'd:PersistentIdC
39                                            #'d:delete-psi :revision revision))
40            ((string= type "ItemIdentity")
41             (delete-identifier-from-jtm delete 'd:ItemIdentifierC
42                                            #'d:delete-item-identifier
43                                            :revision revision))
44            ((string= type "SubjectLocator")
45             (delete-identifier-from-jtm delete 'd:SubjectLocatorC
46                                            #'d:delete-locator :revision revision))
47            ((string= type "Name")
48             (delete-name-from-jtm  delete :revision revision))
49            ((string= type "Variant")
50             (delete-variant-from-jtm delete :revision revision))
51            ((string= type "Occurrence")
52             (delete-occurrence-from-jtm delete :revision revision))
53            ((string= type "Association")
54             (delete-association-from-jtm delete :revision revision))
55            ((string= type "Role")
56             (delete-role-from-jtm delete :revision revision))
57            (t
58             (error "Type \"~a\" is not defined" type))))))
59
60
61(defun delete-role-from-jtm (jtm-decoded-list
62                             &key (revision *TM-REVISION*))
63  "Deletes the passed role object and returns t otherwise this
64   function returns nil."
65  (declare (list jtm-decoded-list) (integer revision))
66  (let* ((prefs (jtm::make-prefix-list-from-jtm-list
67                 (jtm::get-item :PREFIXES jtm-decoded-list)))
68         (ii
69          (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
70            (when curies
71              (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
72         (type
73          (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
74            (when curie
75              (jtm::get-item-from-jtm-reference curie :revision revision
76                                                :prefixes prefs))))
77         (reifier
78          (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
79            (when curie
80              (jtm::get-item-from-jtm-reference
81               curie :revision revision :prefixes prefs))))
82         (parent
83          (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
84                 (parents (jtm::get-items-from-jtm-references
85                           curies :revision revision :prefixes prefs)))
86            (when parents
87              (first parents))))
88         (player-top
89          (let ((curie (jtm::get-item :PLAYER jtm-decoded-list)))
90            (when curie
91              (jtm::get-item-from-jtm-reference curie :revision revision
92                                                :prefixes prefs)))))
93    (let ((role-to-delete
94           (cond (ii
95                  (identified-construct ii :revision revision))
96                 (reifier
97                  (reified-construct reifier :revision revision))
98                 (parent
99                  (let ((found-roles
100                         (tools:remove-null
101                          (map 'list (lambda(role)
102                                       (when (d::equivalent-construct
103                                              role :start-revision revision
104                                              :player player-top
105                                              :instance-of type)
106                                         role))
107                               (roles parent :revision revision)))))
108                    (when found-roles
109                      (first found-roles))))
110                 (t
111                  (error "when deleting a role, there must be an item-identifier, reifier or parent set!")))))
112      (when role-to-delete
113        (delete-role (parent role-to-delete :revision revision)
114                        role-to-delete :revision revision)
115        role-to-delete))))
116         
117
118
119
120(defun delete-association-from-jtm (jtm-decoded-list &key
121                                     (revision *TM-REVISION*))
122  "Deletes the passed association object and returns t otherwise this
123   function returns nil."
124  (declare (list jtm-decoded-list) (integer revision))
125  (let* ((prefs (jtm::make-prefix-list-from-jtm-list
126                 (jtm::get-item :PREFIXES jtm-decoded-list)))
127         (ii
128          (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
129            (when curies
130              (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
131         (scope
132          (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
133            (jtm::get-items-from-jtm-references
134             curies :revision revision :prefixes prefs)))
135         (type
136          (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
137            (when curie
138              (jtm::get-item-from-jtm-reference curie :revision revision
139                                                :prefixes prefs))))
140         (reifier
141          (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
142            (when curie
143              (jtm::get-item-from-jtm-reference
144               curie :revision revision :prefixes prefs))))
145         (roles
146          (map 'list (lambda(jtm-role)
147                       (jtm::make-plist-of-jtm-role
148                        jtm-role :revision revision :prefixes prefs))
149               (jtm::get-item :ROLES jtm-decoded-list))))
150    (let ((assoc-to-delete
151           (cond (ii
152                  (identified-construct ii :revision revision))
153                 (reifier
154                  (reified-construct reifier :revision revision))
155                 (t
156                  (let ((found-assocs
157                         (tools:remove-null
158                          (map 'list (lambda(assoc)
159                                       (d::equivalent-construct
160                                        assoc :start-revision revision
161                                        :roles roles :instance-of type
162                                        :themes scope))
163                               (get-all-associations revision)))))
164                    (when found-assocs
165                      (first found-assocs)))))))
166      (when assoc-to-delete
167        (mark-as-deleted assoc-to-delete :revision revision)
168        assoc-to-delete))))
169
170
171(defun delete-variant-from-jtm (jtm-decoded-list
172                                 &key (revision *TM-REVISION*))
173  "Deletes the passed variant from the given name and returns t if the
174   operation succeeded."
175  (declare (list jtm-decoded-list) (integer revision))
176  (let* ((prefs (jtm::make-prefix-list-from-jtm-list
177                 (jtm::get-item :PREFIXES jtm-decoded-list)))
178         (ii
179          (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
180            (when curies
181              (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
182         (value (jtm::get-item :VALUE jtm-decoded-list))
183         (datatype (jtm::get-item :DATATYPE jtm-decoded-list))
184         (scope
185          (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
186            (jtm::get-items-from-jtm-references
187             curies :revision revision :prefixes prefs)))
188         (parent
189          (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
190                 (parents (jtm::get-items-from-jtm-references
191                           curies :revision revision :prefixes prefs)))
192            (when parents
193              (first parents))))
194         (reifier
195          (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
196            (when curie
197              (jtm::get-item-from-jtm-reference
198               curie :revision revision :prefixes prefs)))))
199    (let ((var-to-delete
200           (cond (ii
201                  (identified-construct ii :revision revision))
202                 (reifier
203                  (reified-construct reifier :revision revision))
204                 (parent
205                  (let ((found-vars
206                         (tools:remove-null
207                          (map 'list (lambda(var)
208                                       (when (d::equivalent-construct
209                                              var :start-revision revision
210                                              :charvalue value :themes scope
211                                              :datatype datatype)
212                                         var))
213                               (variants parent :revision revision)))))
214                    (when found-vars
215                      (first found-vars))))
216                 (t
217                  (error "when deleting a variant, there must be an item-identifier, reifier or parent set!")))))
218      (when var-to-delete
219        (delete-variant (parent var-to-delete :revision revision)
220                        var-to-delete :revision revision)
221        var-to-delete))))
222
223
224(defun delete-occurrence-from-jtm (jtm-decoded-list
225                                   &key (revision *TM-REVISION*))
226  "Deletes the passed occurrence from the given topic and returns t if the
227   operation succeeded."
228  (declare (list jtm-decoded-list) (integer revision))
229  (let* ((prefs (jtm::make-prefix-list-from-jtm-list
230                 (jtm::get-item :PREFIXES jtm-decoded-list)))
231         (ii
232          (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
233            (when curies
234              (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
235         (value (jtm::get-item :VALUE jtm-decoded-list))
236         (datatype
237          (let ((curie (jtm::get-item :DATATYPE jtm-decoded-list)))
238            (cond ((null curie)
239                   constants:*xml-string*)
240                  ((and (tools:string-starts-with curie "[")
241                        (tools:string-ends-with curie "]"))
242                   (jtm::compute-uri-from-jtm-identifier curie prefs))
243                  (t
244                   curie))))
245         (type
246          (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
247            (when curie
248              (jtm::get-item-from-jtm-reference curie :revision revision
249                                                :prefixes prefs))))
250         (scope
251          (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
252            (jtm::get-items-from-jtm-references
253             curies :revision revision :prefixes prefs)))
254         (parent
255          (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
256                 (parents (jtm::get-items-from-jtm-references
257                           curies :revision revision :prefixes prefs)))
258            (when parents
259              (first parents))))
260         (reifier
261          (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
262            (when curie
263              (jtm::get-item-from-jtm-reference
264               curie :revision revision :prefixes prefs)))))
265    (let ((occ-to-delete
266           (cond (ii
267                  (identified-construct ii :revision revision))
268                 (reifier
269                  (reified-construct reifier :revision revision))
270                 (parent
271                  (let ((found-occs
272                         (tools:remove-null
273                          (map 'list (lambda(occ)
274                                       (when (d::equivalent-construct
275                                              occ :start-revision revision
276                                              :charvalue value :themes scope
277                                              :instance-of type :datatype datatype)
278                                         occ))
279                               (occurrences parent :revision revision)))))
280                    (when found-occs
281                      (first found-occs))))
282                 (t
283                  (error "when deleting an occurrence, there must be an item-identifier, reifier or parent set!")))))
284      (when occ-to-delete
285        (delete-occurrence (parent occ-to-delete :revision revision)
286                           occ-to-delete :revision revision)
287        occ-to-delete))))
288
289
290(defun delete-name-from-jtm (jtm-decoded-list
291                              &key (revision *TM-REVISION*))
292  (declare (list jtm-decoded-list) (integer revision))
293  (let* ((prefs (jtm::make-prefix-list-from-jtm-list
294                 (jtm::get-item :PREFIXES jtm-decoded-list)))
295         (ii
296          (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
297            (when curies
298              (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
299         (value (jtm::get-item :VALUE jtm-decoded-list))
300         (type
301          (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
302            (if curie
303                (jtm::get-item-from-jtm-reference curie :revision revision
304                                                  :prefixes prefs)
305                (get-item-by-psi constants:*topic-name-psi*
306                                 :revision revision :error-if-nil t))))
307         (scope
308          (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
309            (jtm::get-items-from-jtm-references
310             curies :revision revision :prefixes prefs)))
311         (parent
312          (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
313                 (parents (jtm::get-items-from-jtm-references
314                           curies :revision revision :prefixes prefs)))
315            (when parents
316              (first parents))))
317         (reifier
318          (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
319            (when curie
320              (jtm::get-item-from-jtm-reference
321               curie :revision revision :prefixes prefs)))))
322    (let ((name-to-delete
323           (cond (ii
324                  (identified-construct ii :revision revision))
325                 (reifier
326                  (reified-construct reifier :revision revision))
327                 (parent
328                  (let ((found-names
329                         (tools:remove-null
330                          (map 'list (lambda(name)
331                                       (when (d::equivalent-construct
332                                              name :start-revision revision
333                                              :charvalue value :themes scope
334                                              :instance-of type)
335                                         name))
336                               (names parent :revision revision)))))
337                    (when found-names
338                      (first found-names))))
339                 (t
340                  (error "when deleting a name, there must be an item-identifier, reifier or parent set!")))))
341      (when name-to-delete
342        (delete-name (parent name-to-delete :revision revision)
343                     name-to-delete :revision revision)
344        name-to-delete))))
345
346
347(defun delete-identifier-from-json (uri class delete-function
348                                    &key (revision *TM-REVISION*))
349  "Deleted the passed identifier of the construct it is associated with.
350   Returns t if there was deleted an item otherweise it returns nil."
351  (declare (string uri) (integer revision) (symbol class))
352  (let ((id (elephant:get-instance-by-value
353              class 'd:uri uri)))
354    (if (and id (typep id class))
355        (progn
356          (apply delete-function
357                 (list (d:identified-construct id :revision revision)
358                       id :revision revision))
359          id)
360        nil)))
361
362
363(defun delete-topic-from-jtm (jtm-decoded-list &key (revision *TM-REVISION*))
364  "Searches for a topic corresponding to the given identifiers.
365   Returns t if there was deleted an item otherweise it returns nil."
366  (declare (list jtm-decoded-list) (integer revision))
367  (let* ((prefs
368          (jtm::make-prefix-list-from-jtm-list
369           (jtm::get-item :PREFIXES jtm-decoded-list)))
370         (ids (append
371               (jtm::get-item :SUBJECT--IDENTIFIERS jtm-decoded-list)
372               (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)
373               (jtm::get-item :SUBJECT--LOCATORS jtm-decoded-list)))
374         (uri (if (null ids)
375                  (error (make-condition 'exceptions::JTM-error :message (format nil "From merge-topic-from-jtm-list(): the passed topic has to own at least one identifier: ~a" jtm-decoded-list)))
376                  (jtm::compute-uri-from-jtm-identifier (first ids) prefs))))
377    (let ((top-to-delete (get-item-by-any-id uri :revision revision)))
378      (when top-to-delete
379        (mark-as-deleted top-to-delete :source-locator uri :revision revision)
380        top-to-delete))))
381
382
383(defun delete-identifier-from-jtm (uri class delete-function
384                                   &key (revision *TM-REVISION*))
385  "Deleted the passed identifier of the construct it is associated with.
386   Returns t if there was deleted an item otherweise it returns nil."
387  (declare (string uri) (integer revision) (symbol class))
388  (let ((id (elephant:get-instance-by-value
389             class 'd:uri uri)))
390    (when (and id (typep id class))
391      (apply delete-function
392             (list (d:identified-construct id :revision revision)
393                   id :revision revision)))))
Note: See TracBrowser for help on using the repository browser.