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))