Changeset 895 for branches/gdl-frontend/src/json/JTM
- Timestamp:
- 09/14/11 07:29:19 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
TabularUnified branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp ¶
r831 r895 13 13 14 14 (in-package :jtm-delete-interface) 15 16 15 17 16 (defun mark-as-deleted-from-jtm (jtm-data &key (revision *TM-REVISION*)) … … 65 64 function returns nil." 66 65 (declare (list jtm-decoded-list) (integer revision)) 67 (let* ((role-to-delete 68 (import-construct-from-jtm-decoded-list 69 jtm-decoded-list :revision revision)) 70 (parent-assoc 71 (when role-to-delete 72 (parent role-to-delete :revision revision)))) 73 (when parent-assoc 74 (d:delete-role parent-assoc role-to-delete :revision revision) 75 role-to-delete))) 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 76 118 77 119 … … 81 123 function returns nil." 82 124 (declare (list jtm-decoded-list) (integer revision)) 83 (let ((assoc 84 (import-construct-from-jtm-decoded-list 85 jtm-decoded-list :revision revision))) 86 (when assoc 87 (d:mark-as-deleted assoc :revision revision :source-locator nil) 88 assoc))) 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)))) 89 169 90 170 … … 94 174 operation succeeded." 95 175 (declare (list jtm-decoded-list) (integer revision)) 96 (let* ((variant-to-delete 97 (import-construct-from-jtm-decoded-list 98 jtm-decoded-list :revision revision)) 99 (parent-name 100 (when variant-to-delete 101 (parent variant-to-delete :revision revision)))) 102 (when parent-name 103 (d:delete-variant parent-name variant-to-delete :revision revision) 104 variant-to-delete))) 105 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)))) 106 222 107 223 … … 111 227 operation succeeded." 112 228 (declare (list jtm-decoded-list) (integer revision)) 113 (let* ((occurrence-to-delete 114 (import-construct-from-jtm-decoded-list 115 jtm-decoded-list :revision revision)) 116 (parent-topic 117 (when occurrence-to-delete 118 (parent occurrence-to-delete :revision revision)))) 119 (when parent-topic 120 (d:delete-occurrence parent-topic occurrence-to-delete :revision revision) 121 occurrence-to-delete))) 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 (jtm::get-item :DATATYPE jtm-decoded-list)) 237 (type 238 (let ((curie (jtm::get-item :TYPE jtm-decoded-list))) 239 (when curie 240 (jtm::get-item-from-jtm-reference curie :revision revision 241 :prefixes prefs)))) 242 (scope 243 (let ((curies (jtm::get-item :SCOPE jtm-decoded-list))) 244 (jtm::get-items-from-jtm-references 245 curies :revision revision :prefixes prefs))) 246 (parent 247 (let* ((curies (jtm::get-item :PARENT jtm-decoded-list)) 248 (parents (jtm::get-items-from-jtm-references 249 curies :revision revision :prefixes prefs))) 250 (when parents 251 (first parents)))) 252 (reifier 253 (let ((curie (jtm::get-item :REIFIER jtm-decoded-list))) 254 (when curie 255 (jtm::get-item-from-jtm-reference 256 curie :revision revision :prefixes prefs))))) 257 (let ((occ-to-delete 258 (cond (ii 259 (identified-construct ii :revision revision)) 260 (reifier 261 (reified-construct reifier :revision revision)) 262 (parent 263 (let ((found-occs 264 (tools:remove-null 265 (map 'list (lambda(occ) 266 (when (d::equivalent-construct 267 occ :start-revision revision 268 :charvalue value :themes scope 269 :instance-of type :datatype datatype) 270 occ)) 271 (occurrences parent :revision revision))))) 272 (when found-occs 273 (first found-occs)))) 274 (t 275 (error "when deleting an occurrence, there must be an item-identifier, reifier or parent set!"))))) 276 (when occ-to-delete 277 (delete-occurrence (parent occ-to-delete :revision revision) 278 occ-to-delete :revision revision) 279 occ-to-delete)))) 122 280 123 281 … … 125 283 &key (revision *TM-REVISION*)) 126 284 (declare (list jtm-decoded-list) (integer revision)) 127 (let* ((name-to-delete 128 (import-construct-from-jtm-decoded-list 129 jtm-decoded-list :revision revision)) 130 (parent-topic 131 (when name-to-delete 132 (parent name-to-delete :revision revision)))) 133 (when parent-topic 134 (d:delete-name parent-topic name-to-delete :revision revision) 135 name-to-delete))) 285 (let* ((prefs (jtm::make-prefix-list-from-jtm-list 286 (jtm::get-item :PREFIXES jtm-decoded-list))) 287 (ii 288 (let ((curies (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list))) 289 (when curies 290 (jtm::compute-uri-from-jtm-identifier (first curies) prefs)))) 291 (value (jtm::get-item :VALUE jtm-decoded-list)) 292 (type 293 (let ((curie (jtm::get-item :TYPE jtm-decoded-list))) 294 (if curie 295 (jtm::get-item-from-jtm-reference curie :revision revision 296 :prefixes prefs) 297 (get-item-by-psi constants:*topic-name-psi* 298 :revision revision :error-if-nil t)))) 299 (scope 300 (let ((curies (jtm::get-item :SCOPE jtm-decoded-list))) 301 (jtm::get-items-from-jtm-references 302 curies :revision revision :prefixes prefs))) 303 (parent 304 (let* ((curies (jtm::get-item :PARENT jtm-decoded-list)) 305 (parents (jtm::get-items-from-jtm-references 306 curies :revision revision :prefixes prefs))) 307 (when parents 308 (first parents)))) 309 (reifier 310 (let ((curie (jtm::get-item :REIFIER jtm-decoded-list))) 311 (when curie 312 (jtm::get-item-from-jtm-reference 313 curie :revision revision :prefixes prefs))))) 314 (let ((name-to-delete 315 (cond (ii 316 (identified-construct ii :revision revision)) 317 (reifier 318 (reified-construct reifier :revision revision)) 319 (parent 320 (let ((found-names 321 (tools:remove-null 322 (map 'list (lambda(name) 323 (when (d::equivalent-construct 324 name :start-revision revision 325 :charvalue value :themes scope 326 :instance-of type) 327 name)) 328 (names parent :revision revision))))) 329 (when found-names 330 (first found-names)))) 331 (t 332 (error "when deleting a name, there must be an item-identifier, reifier or parent set!"))))) 333 (when name-to-delete 334 (delete-name (parent name-to-delete :revision revision) 335 name-to-delete :revision revision) 336 name-to-delete)))) 136 337 137 338 … … 156 357 Returns t if there was deleted an item otherweise it returns nil." 157 358 (declare (list jtm-decoded-list) (integer revision)) 158 (let ((top-to-delete 159 (import-construct-from-jtm-decoded-list 160 jtm-decoded-list :revision revision))) 161 (when top-to-delete 162 (mark-as-deleted top-to-delete :source-locator nil :revision revision) 163 top-to-delete))) 359 360 (let* ((prefs 361 (jtm::make-prefix-list-from-jtm-list 362 (jtm::get-item :PREFIXES jtm-decoded-list))) 363 (ids (append 364 (jtm::get-item :SUBJECT--IDENTIFIERS jtm-decoded-list) 365 (jtm::get-item :ITEM--IDENTIFIERS jtm-decoded-list) 366 (jtm::get-item :SUBJECT--LOCATORS jtm-decoded-list))) 367 (uri (if (null ids) 368 (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))) 369 (jtm::compute-uri-from-jtm-identifier (first ids) prefs)))) 370 (let ((top-to-delete (get-item-by-any-id uri :revision revision))) 371 (when top-to-delete 372 (mark-as-deleted top-to-delete :source-locator uri :revision revision) 373 top-to-delete)))) 164 374 165 375 … … 171 381 (let ((id (elephant:get-instance-by-value 172 382 class 'd:uri uri))) 173 (if (and id (typep id class)) 174 (progn 175 (apply delete-function 176 (list (d:identified-construct id :revision revision) 177 id :revision revision)) 178 id) 179 nil))) 383 (when (and id (typep id class)) 384 (apply delete-function 385 (list (d:identified-construct id :revision revision) 386 id :revision revision)))))
Note: See TracChangeset
for help on using the changeset viewer.
