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

constraints are separate

Now the order of class definitions is irrelevant: constrains that
could not be applied are delayed.

darcs-hash:9e92f505058d2a6bdb03c894931c45195bd9e239
parent 8ac773bd
......@@ -27,8 +27,7 @@ names is used."))
(format nil "~A~{_~A~}_index" (to-sql-name class-name) (mapcar #'to-sql-name fields)))
(type-and-reference (slot)
(if (foreign-type-p slot)
(list :type (if (not-null-p slot) 'integer '(or db-null integer))
:references (list (list (slot-definition-type slot) 'id) :cascade)) ;is this cascade ok?
(list :type (if (not-null-p slot) 'integer '(or db-null integer)))
(list :type (if (not-null-p slot)
(slot-definition-type slot)
`(or db-null ,(slot-definition-type slot)))))))
......@@ -76,7 +75,9 @@ be reverted.)"
(ignore () ())))))
(warn "Table ~A already exists." (class-name class)))
(error err))))))
(error err))))
; here should be some code dropping constraints that are not necessary
(apply-foreign-key-constraints class)))
(defmethod create-table ((name symbol))
(let ((class (find-class name)))
......@@ -186,6 +187,7 @@ table ~A. This may indicate that something is wrong." (first column) (second col
:type (second field)
:format-control "Column ~A in table ~A does not exist."
:format-arguments (list (car field) class-name)))))))
; do here something with constraints involving the table
(values))))
;;; Copyright (C) 2007
......
......@@ -86,9 +86,37 @@ metaclass set to DB-CLASS."
;; case.
(declare (ignore rest slots))
(finalize-inheritance class)
(collect-constraints class)
(when (db-class-connection-spec class)
(try-delayed-constraints class)
(create-table class)))
(defmethod collect-constraints ((class db-class))
;the slots collecting the constraints should be set to nil before
;doing anything!
(setf (db-class-foreign-keys class) nil)
(setf (db-class-unique-keys class) nil)
(iter (for slot in (class-slots class))
(when (foreign-type-p slot)
(push slot (db-class-foreign-keys class)))
(when (unique slot)
(push slot (db-class-unique-keys class)))))
(defgeneric try-delayed-constraints (class)
(:documentation "Try to call all the delayed constraints present.")
(:method ((class db-class))
;remove classes that are not dirty anymore:
(setf (db-class-unfinished-classes class)
(delete-if (lambda (x) (notany #'delayed-constraint (class-slots x))) (db-class-unfinished-classes class)))
(iter (for dirty-class in (db-class-unfinished-classes class))
(iter (for slot in (class-slots dirty-class))
(when (delayed-constraint slot)
(handler-case (progn (funcall (delayed-constraint slot))
(setf (delayed-constraint slot) nil))
(database-error ()
nil)))))))
;;; Copyright (C) 2007
;;; Ryszard Szopa <ryszard.szopa@gmail.com> &
;;; Streamtech http://streamtech.nl/
......
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