Commit 8ac773bd authored by ryszard.szopa's avatar ryszard.szopa
Browse files

add-constraint and apply-foreign-key-constraints

darcs-hash:4aa4d55b0d989e3006469cb17a2e51595fc5cc54
parent 06338d08
......@@ -82,6 +82,42 @@ be reverted.)"
(let ((class (find-class name)))
(create-table class)))
(defgeneric add-constraint (slot constraint)
(:documentation "Add a constraint to this slot's class' table."))
(defmethod add-constraint :around ((slot db-class-slot-definition) constraint)
(let ((class (slot-value slot 'sb-pcl::allocation-class)))
(with-class-connection (class)
(postmodern:execute (format nil "ALTER TABLE ~A ADD ~A;"
(class-name class)
(call-next-method))))))
(defmethod add-constraint ((slot db-class-slot-definition) (constraint (eql :foreign-key)))
(format nil "FOREIGN KEY (~A) REFERENCES ~A ON DELETE ~A"
(sql-ize (slot-definition-name slot))
(sql-ize (slot-definition-type slot))
(case (on-delete slot)
(:set-null "SET NULL")
(:set-default "SET DEFAULT")
(otherwise (on-delete slot)))))
(defmethod add-constraint ((slot db-class-slot-definition) (constraint (eql :unique)))
(format nil "UNIQUE ~A"
(sql-ize (slot-definition-name slot))))
(defmethod apply-foreign-key-constraints ((class db-class))
(iter (for slot in (db-class-foreign-keys class))
(let ((closure (lambda ()
(add-constraint slot :foreign-key))))
;todo: in case of errors store the closure
(handler-case (funcall closure)
(database-error ()
(setf (delayed-constraint slot) closure)
(unless (member class (db-class-unfinished-classes class)
:test (lambda (x y)
(eql (class-name x) (class-name y))))
(push class (db-class-unfinished-classes class)))
)))))
(define-condition sql-error (simple-error)
((table :initarg :table-name :reader table-name))
......
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