Commit efea861f authored by ryszard.szopa's avatar ryszard.szopa
Browse files

non-transient-slots -> db-slots

Functions refering to non-transient slots now also reject slots whose allocation is :CLASS.

darcs-hash:c4772436d7dbc5ebbc43ac2d71cce80d56495766
parent 0e040f4e
......@@ -35,7 +35,7 @@ with a non-existant ID."))
(defgeneric save-all-foreign-daos (dao)
(:documentation "Saves recursively all foreign daos in the slots of DAO")
(:method ((dao dao))
(iter (for slot in (mapcar #'slot-definition-name (non-transient-slots-of dao)))
(iter (for slot in (mapcar #'slot-definition-name (db-slots-of dao)))
(let ((s-value (slot-value dao slot)))
(when (typep s-value 'dao)
(save-dao s-value))))))
......@@ -50,7 +50,7 @@ exists in the database.")
:single)))))
(defun set-fields (object)
(iter (for field in (mapcar #'slot-definition-name (non-transient-slots-of object)))
(iter (for field in (mapcar #'slot-definition-name (db-slots-of object)))
(appending `(,field ,(slot-value-or-id-if-foreign object field)))))
(defun id-seq-name (class)
......@@ -97,7 +97,7 @@ any)."
:format-control "You tried to create a DAO with a non-existant ID."
:id (get-id dao) :type (class-name-of dao))))
(iter
(for slot in (non-transient-slots-of dao))
(for slot in (db-slots-of dao))
(let ((slot-name (slot-definition-name slot)))
(unless (equal 'id slot-name)
......
......@@ -36,7 +36,7 @@ names is used."))
(postmodern:execute
(sql-compile
`(:create-table ,class-name
,(iter (for slot in (class-non-transient-slots class))
,(iter (for slot in (class-db-slots class))
(collect
(cons (slot-definition-name slot) (type-and-reference slot))))
(:primary-key id)))) ;id is hardcoded as a primary key
......@@ -118,7 +118,7 @@ function.")
(equal (car field1) (car field2))
(string= (extract-type field1) (extract-type field2)))))
(let ((fields
(mapcar #'prepare-field (class-non-transient-slots class)))
(mapcar #'prepare-field (class-db-slots class)))
(columns (postmodern::query (sql (:select 'column-name 'data-type
:from 'information_schema.columns
:where (:= 'table-name (sql-ize class-name)))))))
......
......@@ -7,13 +7,17 @@
;;
;;
(defun class-non-transient-slots (class)
"Return the list of non-transient slots of a class."
(remove-if #'transient-p (class-slots class)))
(defun non-db-slot (slot)
"Slot is transient or its allocation is :CLASS."
(or (transient-p slot) (eql (slot-definition-allocation slot) :class)))
(defun non-transient-slots-of (object)
"List of non-tansient slots of OBJECT"
(remove-if #'transient-p (slots-of object)))
(defun class-db-slots (class)
"Return the list of non-transient, instance allocated slots of a class."
(remove-if #'non-db-slot (class-slots class)))
(defun db-slots-of (object)
"List of non-transient, instance allocated slots of OBJECT"
(remove-if #'non-db-slot (slots-of object)))
(defun slot-value-or-id-if-foreign (object slot)
"SLOT-VALUE if SLOT in OBJECT is not foreign, the ID of the object in the slot otherwise."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment