Commit 77622df1 authored by ryszard.szopa's avatar ryszard.szopa
Browse files

refactoring: new file, dao.lisp

darcs-hash:d8c79de74708239a5040b73e5b16f2faca43fa05
parent fa3ca659
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; -*-
(in-package :submarine)
;;
;; DAO
;;
;;
(defclass dao ()
((id :type integer :accessor get-id :initarg :id))
(:indices)
(:metaclass db-class)
(:documentation "Base class for any PostgreSQL aware classes."))
(defgeneric save-dao (object)
(:documentation "Save a dao: update it when it already exists, insert it otherwise.")
(:method ((dao dao))
(if (dao-exists-p dao)
(update-dao dao)
(insert-dao dao))))
(defgeneric save-all-foreign-daos (dao)
(:documentation "Saves recursively all daos in the slots of DAO")
(:method ((dao dao))
(iter (for slot in (non-transient-slots-of dao))
(let ((s-value (slot-value dao slot)))
(when (typep s-value 'dao)
(save-dao s-value))))))
(defgeneric dao-exists-p (dao)
(:documentation "Return a boolean indicating whether the given dao
exists in the database.")
(:method ((dao dao))
(with-class-connection (dao)
(and (slot-boundp dao 'id)
(postmodern::query (:select (:exists (:select 1 :from (class-name-of dao) :where (:= 'id (get-id dao)))))
:single)))))
(defun set-fields (object)
(iter (for field in (slots-of object))
(appending `(',field ,(slot-value-or-id-if-foreign object field)))))
(defun id-seq-name (class)
(intern (format nil "~A-ID-SEQ" (class-name class)) :keyword))
(defgeneric insert-dao (dao)
(:documentation "Insert the given dao into the database.")
(:method ((dao dao))
(with-class-connection (dao)
(unless (slot-boundp dao 'id)
(setf (slot-value dao 'id) (postmodern::sequence-next (id-seq-name (class-of dao)))))
(postmodern::execute (sql-compile `(:insert-into ,(class-name-of dao) :set ,@(set-fields dao)))))))
(defgeneric update-dao (dao)
(:documentation "Update the dao's representation in the database
with the values in the given object."))
(defmethod update-dao ((dao dao))
(with-class-connection (dao)
(postmodern::execute (sql-compile
`(:update ,(class-name-of dao) :set ,@(set-fields dao)
:where (:= 'id (get-id dao)))))))
(defgeneric delete-dao (dao)
(:documentation "Delete the given dao from the database."))
;(defun get-dao (type id)
; (select object type &optional test)
......@@ -145,77 +145,4 @@ table ~A. This may indicate that something is wrong." (first column) (second col
:format-control "Column ~A in table ~A does not exist."
:format-arguments (list (car field) class-name)))))))
(values))))
;;
;; DAO
;;
;;
(defclass dao ()
((id :type integer :accessor get-id :initarg :id))
(:indices)
(:metaclass db-class)
(:documentation "Base class for any PostgreSQL aware classes."))
(defgeneric save-dao (object)
(:documentation "Save a dao: update it when it already exists, insert it otherwise.")
(:method ((dao dao))
(if (dao-exists-p dao)
(update-dao dao)
(insert-dao dao))))
(defgeneric save-all-foreign-daos (dao)
(:documentation "Saves recursively all daos in the slots of DAO")
(:method ((dao dao))
(iter (for slot in (non-transient-slots-of dao))
(let ((s-value (slot-value dao slot)))
(when (typep s-value 'dao)
(save-dao s-value))))))
(defgeneric dao-exists-p (dao)
(:documentation "Return a boolean indicating whether the given dao
exists in the database.")
(:method ((dao dao))
(and (slot-boundp dao 'id)
(postmodern::query (:select (:exists (:select 1 :from (class-name-of dao) :where (:= 'id (get-id dao)))))
:single))))
(defun set-fields (object)
(iter (for field in (slots-of object))
(appending `(',field ,(slot-value-or-id-if-foreign object field)))))
(defun id-seq-name (class)
(intern (format nil "~A-ID-SEQ" (class-name class)) :keyword))
(defgeneric insert-dao (dao)
(:documentation "Insert the given dao into the database.")
(:method ((dao dao))
(unless (slot-boundp dao 'id)
(setf (slot-value dao 'id) (postmodern::sequence-next (id-seq-name (class-of dao)))))
(postmodern::execute (sql-compile `(:insert-into ,(class-name-of dao) :set ,@(set-fields dao))))))
(defgeneric update-dao (dao)
(:documentation "Update the dao's representation in the database
with the values in the given object."))
(defmethod update-dao ((dao dao))
(postmodern::execute (sql-compile
`(:update ,(class-name-of dao) :set ,@(set-fields dao)
:where (:= 'id (get-id dao))))))
(defgeneric delete-dao (dao)
(:documentation "Delete the given dao from the database."))
(defclass test1 (dao)
((foo :type integer :accessor foo :initarg :foo))
(:metaclass db-class))
(defclass test2 (dao)
((foreign-foo :type test1 :initarg :foo)
(transient-slot :type integer :transient t))
(:metaclass db-class))
; (select object type &optional test)
......@@ -12,4 +12,5 @@
((:file "package")
(:file "utilities")
(:file "mop")
(:file "db")))
\ No newline at end of file
(:file "db")
(:file "dao")))
\ No newline at end of file
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