[isidorus-cvs] r895 - in branches/gdl-frontend/src: json/JTM model
lgiessmann at common-lisp.net
lgiessmann at common-lisp.net
Wed Sep 14 07:29:21 UTC 2011
Author: lgiessmann
Date: Wed Sep 14 00:29:19 2011
New Revision: 895
Log:
jtm-delete-interface: changed the implementation of the delete interface => not the constructs that will be deleted won't instantiated before te actual delete operation is invoked
Modified:
branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp
branches/gdl-frontend/src/model/datamodel.lisp
Modified: branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp
==============================================================================
--- branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp Tue Sep 13 22:56:28 2011 (r894)
+++ branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp Wed Sep 14 00:29:19 2011 (r895)
@@ -13,7 +13,6 @@
(in-package :jtm-delete-interface)
-
(defun mark-as-deleted-from-jtm (jtm-data &key (revision *TM-REVISION*))
"Marks an object that is specified by the given JSON data as deleted."
(declare (string jtm-data) (integer revision))
@@ -64,15 +63,58 @@
"Deletes the passed role object and returns t otherwise this
function returns nil."
(declare (list jtm-decoded-list) (integer revision))
- (let* ((role-to-delete
- (import-construct-from-jtm-decoded-list
- jtm-decoded-list :revision revision))
- (parent-assoc
- (when role-to-delete
- (parent role-to-delete :revision revision))))
- (when parent-assoc
- (d:delete-role parent-assoc role-to-delete :revision revision)
- role-to-delete)))
+ (let* ((prefs (jtm::make-prefix-list-from-jtm-list
+ (jtm::get-item :PREFIXES jtm-decoded-list)))
+ (ii
+ (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
+ (when curies
+ (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
+ (type
+ (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference curie :revision revision
+ :prefixes prefs))))
+ (reifier
+ (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference
+ curie :revision revision :prefixes prefs))))
+ (parent
+ (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
+ (parents (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (when parents
+ (first parents))))
+ (player-top
+ (let ((curie (jtm::get-item :PLAYER jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference curie :revision revision
+ :prefixes prefs)))))
+ (let ((role-to-delete
+ (cond (ii
+ (identified-construct ii :revision revision))
+ (reifier
+ (reified-construct reifier :revision revision))
+ (parent
+ (let ((found-roles
+ (tools:remove-null
+ (map 'list (lambda(role)
+ (when (d::equivalent-construct
+ role :start-revision revision
+ :player player-top
+ :instance-of type)
+ role))
+ (roles parent :revision revision)))))
+ (when found-roles
+ (first found-roles))))
+ (t
+ (error "when deleting a role, there must be an item-identifier, reifier or parent set!")))))
+ (when role-to-delete
+ (delete-role (parent role-to-delete :revision revision)
+ role-to-delete :revision revision)
+ role-to-delete))))
+
+
(defun delete-association-from-jtm (jtm-decoded-list &key
@@ -80,12 +122,50 @@
"Deletes the passed association object and returns t otherwise this
function returns nil."
(declare (list jtm-decoded-list) (integer revision))
- (let ((assoc
- (import-construct-from-jtm-decoded-list
- jtm-decoded-list :revision revision)))
- (when assoc
- (d:mark-as-deleted assoc :revision revision :source-locator nil)
- assoc)))
+ (let* ((prefs (jtm::make-prefix-list-from-jtm-list
+ (jtm::get-item :PREFIXES jtm-decoded-list)))
+ (ii
+ (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
+ (when curies
+ (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
+ (scope
+ (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
+ (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (type
+ (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference curie :revision revision
+ :prefixes prefs))))
+ (reifier
+ (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference
+ curie :revision revision :prefixes prefs))))
+ (roles
+ (map 'list (lambda(jtm-role)
+ (jtm::make-plist-of-jtm-role
+ jtm-role :revision revision :prefixes prefs))
+ (jtm::get-item :ROLES jtm-decoded-list))))
+ (let ((assoc-to-delete
+ (cond (ii
+ (identified-construct ii :revision revision))
+ (reifier
+ (reified-construct reifier :revision revision))
+ (t
+ (let ((found-assocs
+ (tools:remove-null
+ (map 'list (lambda(assoc)
+ (d::equivalent-construct
+ assoc :start-revision revision
+ :roles roles :instance-of type
+ :themes scope))
+ (get-all-associations revision)))))
+ (when found-assocs
+ (first found-assocs)))))))
+ (when assoc-to-delete
+ (mark-as-deleted assoc-to-delete :revision revision)
+ assoc-to-delete))))
(defun delete-variant-from-jtm (jtm-decoded-list
@@ -93,16 +173,52 @@
"Deletes the passed variant from the given name and returns t if the
operation succeeded."
(declare (list jtm-decoded-list) (integer revision))
- (let* ((variant-to-delete
- (import-construct-from-jtm-decoded-list
- jtm-decoded-list :revision revision))
- (parent-name
- (when variant-to-delete
- (parent variant-to-delete :revision revision))))
- (when parent-name
- (d:delete-variant parent-name variant-to-delete :revision revision)
- variant-to-delete)))
-
+ (let* ((prefs (jtm::make-prefix-list-from-jtm-list
+ (jtm::get-item :PREFIXES jtm-decoded-list)))
+ (ii
+ (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
+ (when curies
+ (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
+ (value (jtm::get-item :VALUE jtm-decoded-list))
+ (datatype (jtm::get-item :DATATYPE jtm-decoded-list))
+ (scope
+ (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
+ (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (parent
+ (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
+ (parents (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (when parents
+ (first parents))))
+ (reifier
+ (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference
+ curie :revision revision :prefixes prefs)))))
+ (let ((var-to-delete
+ (cond (ii
+ (identified-construct ii :revision revision))
+ (reifier
+ (reified-construct reifier :revision revision))
+ (parent
+ (let ((found-vars
+ (tools:remove-null
+ (map 'list (lambda(var)
+ (when (d::equivalent-construct
+ var :start-revision revision
+ :charvalue value :themes scope
+ :datatype datatype)
+ var))
+ (variants parent :revision revision)))))
+ (when found-vars
+ (first found-vars))))
+ (t
+ (error "when deleting a variant, there must be an item-identifier, reifier or parent set!")))))
+ (when var-to-delete
+ (delete-variant (parent var-to-delete :revision revision)
+ var-to-delete :revision revision)
+ var-to-delete))))
(defun delete-occurrence-from-jtm (jtm-decoded-list
@@ -110,29 +226,114 @@
"Deletes the passed occurrence from the given topic and returns t if the
operation succeeded."
(declare (list jtm-decoded-list) (integer revision))
- (let* ((occurrence-to-delete
- (import-construct-from-jtm-decoded-list
- jtm-decoded-list :revision revision))
- (parent-topic
- (when occurrence-to-delete
- (parent occurrence-to-delete :revision revision))))
- (when parent-topic
- (d:delete-occurrence parent-topic occurrence-to-delete :revision revision)
- occurrence-to-delete)))
+ (let* ((prefs (jtm::make-prefix-list-from-jtm-list
+ (jtm::get-item :PREFIXES jtm-decoded-list)))
+ (ii
+ (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
+ (when curies
+ (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
+ (value (jtm::get-item :VALUE jtm-decoded-list))
+ (datatype (jtm::get-item :DATATYPE jtm-decoded-list))
+ (type
+ (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference curie :revision revision
+ :prefixes prefs))))
+ (scope
+ (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
+ (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (parent
+ (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
+ (parents (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (when parents
+ (first parents))))
+ (reifier
+ (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference
+ curie :revision revision :prefixes prefs)))))
+ (let ((occ-to-delete
+ (cond (ii
+ (identified-construct ii :revision revision))
+ (reifier
+ (reified-construct reifier :revision revision))
+ (parent
+ (let ((found-occs
+ (tools:remove-null
+ (map 'list (lambda(occ)
+ (when (d::equivalent-construct
+ occ :start-revision revision
+ :charvalue value :themes scope
+ :instance-of type :datatype datatype)
+ occ))
+ (occurrences parent :revision revision)))))
+ (when found-occs
+ (first found-occs))))
+ (t
+ (error "when deleting an occurrence, there must be an item-identifier, reifier or parent set!")))))
+ (when occ-to-delete
+ (delete-occurrence (parent occ-to-delete :revision revision)
+ occ-to-delete :revision revision)
+ occ-to-delete))))
(defun delete-name-from-jtm (jtm-decoded-list
&key (revision *TM-REVISION*))
(declare (list jtm-decoded-list) (integer revision))
- (let* ((name-to-delete
- (import-construct-from-jtm-decoded-list
- jtm-decoded-list :revision revision))
- (parent-topic
- (when name-to-delete
- (parent name-to-delete :revision revision))))
- (when parent-topic
- (d:delete-name parent-topic name-to-delete :revision revision)
- name-to-delete)))
+ (let* ((prefs (jtm::make-prefix-list-from-jtm-list
+ (jtm::get-item :PREFIXES jtm-decoded-list)))
+ (ii
+ (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)))
+ (when curies
+ (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
+ (value (jtm::get-item :VALUE jtm-decoded-list))
+ (type
+ (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
+ (if curie
+ (jtm::get-item-from-jtm-reference curie :revision revision
+ :prefixes prefs)
+ (get-item-by-psi constants:*topic-name-psi*
+ :revision revision :error-if-nil t))))
+ (scope
+ (let ((curies (jtm::get-item :SCOPE jtm-decoded-list)))
+ (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (parent
+ (let* ((curies (jtm::get-item :PARENT jtm-decoded-list))
+ (parents (jtm::get-items-from-jtm-references
+ curies :revision revision :prefixes prefs)))
+ (when parents
+ (first parents))))
+ (reifier
+ (let ((curie (jtm::get-item :REIFIER jtm-decoded-list)))
+ (when curie
+ (jtm::get-item-from-jtm-reference
+ curie :revision revision :prefixes prefs)))))
+ (let ((name-to-delete
+ (cond (ii
+ (identified-construct ii :revision revision))
+ (reifier
+ (reified-construct reifier :revision revision))
+ (parent
+ (let ((found-names
+ (tools:remove-null
+ (map 'list (lambda(name)
+ (when (d::equivalent-construct
+ name :start-revision revision
+ :charvalue value :themes scope
+ :instance-of type)
+ name))
+ (names parent :revision revision)))))
+ (when found-names
+ (first found-names))))
+ (t
+ (error "when deleting a name, there must be an item-identifier, reifier or parent set!")))))
+ (when name-to-delete
+ (delete-name (parent name-to-delete :revision revision)
+ name-to-delete :revision revision)
+ name-to-delete))))
(defun delete-identifier-from-json (uri class delete-function
@@ -155,12 +356,21 @@
"Searches for a topic corresponding to the given identifiers.
Returns t if there was deleted an item otherweise it returns nil."
(declare (list jtm-decoded-list) (integer revision))
- (let ((top-to-delete
- (import-construct-from-jtm-decoded-list
- jtm-decoded-list :revision revision)))
- (when top-to-delete
- (mark-as-deleted top-to-delete :source-locator nil :revision revision)
- top-to-delete)))
+
+ (let* ((prefs
+ (jtm::make-prefix-list-from-jtm-list
+ (jtm::get-item :PREFIXES jtm-decoded-list)))
+ (ids (append
+ (jtm::get-item :SUBJECT--IDENTIFIERS jtm-decoded-list)
+ (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list)
+ (jtm::get-item :SUBJECT--LOCATORS jtm-decoded-list)))
+ (uri (if (null ids)
+ (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)))
+ (jtm::compute-uri-from-jtm-identifier (first ids) prefs))))
+ (let ((top-to-delete (get-item-by-any-id uri :revision revision)))
+ (when top-to-delete
+ (mark-as-deleted top-to-delete :source-locator uri :revision revision)
+ top-to-delete))))
(defun delete-identifier-from-jtm (uri class delete-function
@@ -170,10 +380,7 @@
(declare (string uri) (integer revision) (symbol class))
(let ((id (elephant:get-instance-by-value
class 'd:uri uri)))
- (if (and id (typep id class))
- (progn
- (apply delete-function
- (list (d:identified-construct id :revision revision)
- id :revision revision))
- id)
- nil)))
\ No newline at end of file
+ (when (and id (typep id class))
+ (apply delete-function
+ (list (d:identified-construct id :revision revision)
+ id :revision revision)))))
\ No newline at end of file
Modified: branches/gdl-frontend/src/model/datamodel.lisp
==============================================================================
--- branches/gdl-frontend/src/model/datamodel.lisp Tue Sep 13 22:56:28 2011 (r894)
+++ branches/gdl-frontend/src/model/datamodel.lisp Wed Sep 14 00:29:19 2011 (r895)
@@ -1583,10 +1583,10 @@
(locators top :revision 0))
(mapc (lambda (name) (mark-as-deleted name :revision revision
:source-locator source-locator))
- (names top :revision 0))
+ (names top :revision 0))
(mapc (lambda (occ) (mark-as-deleted occ :revision revision
:source-locator source-locator))
- (occurrences top :revision 0))
+ (occurrences top :revision 0))
(mapc (lambda (ass) (mark-as-deleted ass :revision revision
:source-locator source-locator))
(find-all-associations top :revision 0))
More information about the Isidorus-cvs
mailing list