From 1fc17e7b7872a083d79b3e2e4055a4684c6ed975 Mon Sep 17 00:00:00 2001 From: Maciej Pasternacki Date: Sun, 12 Apr 2009 02:13:33 +0200 Subject: [PATCH] taxonomy: (SETF ITEM-TERMS) --- src/taxonomy.lisp | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/taxonomy.lisp b/src/taxonomy.lisp index ad870bc..bccb8d6 100644 --- a/src/taxonomy.lisp +++ b/src/taxonomy.lisp @@ -367,6 +367,27 @@ If TAXONOMY is not given, returns terms in all taxonomies." (:= 'term.term-id 'item-term.term-id))) 'item-term.item-term-order)))) +(defun (setf item-terms) (new-terms item &optional taxonomy) + "Resets ITEM's terms to NEW-TERMS. Restricts to terms in TAXONOMY, if needed. + +Doesn't touch values or order of terms that are left. Sets order of +added terms to NULL." + (let* ((old-terms (item-terms item taxonomy)) + (new-ids (mapcar #'id new-terms)) + (old-ids (mapcar #'id old-terms)) + (ids-to-del (set-difference old-ids new-ids)) + (ids-to-add (set-difference new-ids old-ids))) + (with-transaction () + (when ids-to-del + (execute (:delete-from 'item-term :where + (:and (:= 'item-id (id item)) + (:in 'term-id (:set ids-to-del)))))) + (when ids-to-add + (execute (:insert-rows-into 'item-term + :columns 'item-id 'term-id + :values (loop for id in ids-to-add + collect (list (id item) id)))))))) + (defun order-case-ssql (column values) `(:case ,@(loop -- 2.11.4.GIT