Author: achiumenti Date: Thu Sep 18 09:31:55 2008 New Revision: 93
Modified: trunk/main/claw-demo/src/backend/dao.lisp trunk/main/claw-demo/src/backend/packages.lisp trunk/main/claw-demo/src/backend/service.lisp trunk/main/claw-demo/src/backend/setup.lisp trunk/main/claw-demo/src/backend/vo.lisp Log: several bugfixes and enhancements
Modified: trunk/main/claw-demo/src/backend/dao.lisp ============================================================================== --- trunk/main/claw-demo/src/backend/dao.lisp (original) +++ trunk/main/claw-demo/src/backend/dao.lisp Thu Sep 18 09:31:55 2008 @@ -29,6 +29,16 @@
(in-package :claw-demo-backend)
+(defun slot-column-name (symbol-class slot-name) + (when (stringp slot-name) + (setf slot-name (intern (string-upcase slot-name) 'claw-demo-backend))) + (let ((slot (loop for slot in (closer-mop:class-slots (find-class symbol-class)) + when (and (typep slot 'clsql-sys::view-class-effective-slot-definition) + (equal (closer-mop:slot-definition-name slot) slot-name)) + return slot))) + (when slot + (slot-value slot 'clsql-sys::column)))) + (defgeneric check-instance-version (base-table &key database) (:documentation "Versioning support for base-table instances"))
@@ -56,29 +66,17 @@ (setf (table-update-user base-table) user-name (table-update-date base-table) now-timestamp)))
- -(defun slot-column-name (symbol-class slot-name) - (when (stringp slot-name) - (setf slot-name (intern (string-upcase slot-name) 'claw-demo-backend))) - (let ((slot (loop for slot in (closer-mop:class-slots (find-class symbol-class)) - when (and (typep slot 'clsql-sys::view-class-effective-slot-definition) - (equal (closer-mop:slot-definition-name slot) slot-name)) - return slot))) - (when slot - (slot-value slot 'clsql-sys::column)))) - (defun sql-expression-upper (&key string table alias attribute type) (sql-operation 'upper (sql-expression :string string :table table :alias alias :attribute attribute :type type)))
-#.(locally-enable-sql-reader-syntax)
-(defmethod check-instance-version ((instance base-table) &key (database *default-database*)) +(defmethod check-instance-version ((instance base-table) &key (database *claw-demo-db*)) (let* ((instance-version (table-version instance)) (table (view-table (class-of instance))) (instance-id (table-id instance)) - (version (first (select [version] + (version (first (select (slot-column-name 'base-table 'version) :from table - :where [= [id] instance-id] + :where (sql-operation '= (slot-column-name 'base-table 'id) instance-id) :flatp t :refresh t :database database)))) @@ -90,11 +88,11 @@ table))))
(defmethod delete-instance-records :before ((instance base-table)) - (check-instance-version instance :database (clsql-sys::view-database instance))) + (check-instance-version instance :database *claw-demo-db*))
-(defmethod update-records-from-instance :before ((instance base-table) &key (database *default-database*)) +(defmethod update-records-from-instance :before ((instance base-table) &key (database *claw-demo-db*)) (check-instance-version instance :database database) (sign-table-update instance) (if (and (slot-boundp instance 'id) (not (null (table-id instance)))) @@ -105,48 +103,87 @@ (string-downcase (symbol-name (view-table (class-of instance))))))) (setf (table-id instance) (sequence-next sequence-name :database database))))))
-(defmethod update-record-from-slot :before ((instance base-table) slot &key (database *default-database*)) +(defmethod update-record-from-slot :before ((instance base-table) slot &key (database *claw-demo-db*)) (declare (ignore slot database)) (check-instance-version instance))
-(defmethod update-records-from-instance :before ((instance user) &key (database *default-database*)) - (let ((id (table-id instance))) +(defmethod update-records-from-instance :before ((instance user) &key (database *claw-demo-db*)) + (let ((id (table-id instance)) + (role-list (user-roles instance)) + (role-id-column-name (slot-column-name 'user-role 'role-id)) + (table-name (symbol-name (view-table (find-class 'user-role))))) (when id - (delete-records :from [users-roles] :where [= [user-id] id])))) - -(defmethod update-records-from-instance :after ((instance user) &key (database *default-database*)) - (let ((id (table-id instance))) - (dolist (role (user-roles instance)) - (update-records-from-instance (make-instance 'user-role :user-id id :role-id (table-id role)))))) - - -(defmethod update-records-from-instance :before ((instance customer) &key (database *default-database*)) - (let ((id (table-id instance))) + (delete-records :from table-name + :where (sql-operation 'and + (sql-operation '= (slot-column-name 'user-role 'user-id) id) + (sql-operation 'not (sql-operation 'in role-id-column-name + (loop for user-role in role-list + collect (table-id user-role))))) + :database database)))) + +(defmethod update-records-from-instance :after ((instance user) &key (database *claw-demo-db*)) + (with-transaction (:database database) + (let* ((id (table-id instance)) + (table-name (view-table (find-class 'user-role))) + (user-id-column-name (slot-column-name 'user-role 'user-id)) + (role-id-column-name (slot-column-name 'user-role 'role-id)) + (role-list (user-roles instance)) + (roles-already-present-id-list (select role-id-column-name + :from table-name + :where (sql-operation 'in user-id-column-name + (loop for user-role in role-list + collect (table-id user-role))) + :flatp t + :refresh t + :database database))) + (dolist (role (user-roles instance)) + (unless (member (table-id role) roles-already-present-id-list) + (update-records-from-instance (make-instance 'user-role + :user-id id + :role-id (table-id role)) :database database)))))) + + +(defmethod update-records-from-instance :before ((instance customer) &key (database *claw-demo-db*)) + (let ((id (table-id instance)) + (address-list (customer-addresses instance)) + (address-id-column-name (slot-column-name 'customer-address 'id)) + (table-name (symbol-name (view-table (find-class 'customer-address))))) (when id - (delete-records :from [customer-addresses] :where [= [customer-id] id])))) + (delete-records :from table-name + :where (sql-operation 'and + (sql-operation '= (slot-column-name 'customer-address 'customer-id) id) + (sql-operation 'not (sql-operation 'in address-id-column-name + (loop for customer-address in address-list + collect (table-id customer-address))))) + :database database) + (setf (customer-addresses instance) address-list))))
-(defmethod update-records-from-instance :after ((instance customer) &key (database *default-database*)) +(defmethod update-records-from-instance :after ((instance customer) &key (database *claw-demo-db*)) (let ((id (table-id instance))) (dolist (address (customer-addresses instance)) (setf (customer-address-customer-id address) id) - (update-records-from-instance address)))) + (update-records-from-instance address :database database))))
(defmethod delete-instance-records :before ((instance user)) (let ((id (table-id instance))) (when id - (delete-records :from [users-roles] :where [= [user-id] id])))) + (delete-records :from (symbol-name (view-table (find-class 'user-role))) + :where (sql-operation '= (slot-column-name 'user-role 'role-id) id) + :database *claw-demo-db*))))
(defmethod delete-instance-records :before ((instance customer)) (let ((id (table-id instance))) (when id - (delete-records :from [customer-addresses] :where [= [customer-id] id])))) + (delete-records :from (symbol-name (view-table (find-class 'customer-address))) + :where (sql-operation '= (slot-column-name 'customer-address 'customer-id) id)))))
(defmethod delete-instance-records :before ((instance role)) (let ((id (table-id instance))) (when id - (delete-records :from [users-roles] :where [= [role-id] id])))) + (delete-records :from (symbol-name (view-table (find-class 'user-role))) + :where (sql-operation '= (slot-column-name 'user-role 'role-id) id)))))
(defun like-operation (name value &key (insensitive t) (wild-char #*)) (setf value (format nil "~{~A~^\\~}" (split-sequence #\ value))) @@ -165,4 +202,3 @@ v))) result))
-#.(locally-disable-sql-reader-syntax) \ No newline at end of file
Modified: trunk/main/claw-demo/src/backend/packages.lisp ============================================================================== --- trunk/main/claw-demo/src/backend/packages.lisp (original) +++ trunk/main/claw-demo/src/backend/packages.lisp Thu Sep 18 09:31:55 2008 @@ -40,7 +40,8 @@ :universal-time :parse-timestring) (:documentation "A demo application for CLAW") - (:export #:demo-setup + (:export #:*claw-demo-db* + #:demo-setup #:db-connect #:db-disconnect ;; --- Value objects --- ;; @@ -89,7 +90,7 @@ #:customer-address #:customer-address-name1 #:customer-address-name2 - #:customer-address-address-type + #:customer-address-type #:customer-address-address #:customer-address-city #:customer-address-zip @@ -100,6 +101,7 @@ #:delete-db-item #:reload-db-item #:find-by-id + #:delete-by-id #:delete-class-records #:find-user-by-name #:find-customers)) \ No newline at end of file
Modified: trunk/main/claw-demo/src/backend/service.lisp ============================================================================== --- trunk/main/claw-demo/src/backend/service.lisp (original) +++ trunk/main/claw-demo/src/backend/service.lisp Thu Sep 18 09:31:55 2008 @@ -40,8 +40,6 @@ (defgeneric reload-db-item (base-table) (:documentation "Reloads an item."))
-#.(locally-enable-sql-reader-syntax) - (defmethod update-db-item ((item base-table)) (with-transaction (:database *claw-demo-db*) (update-records-from-instance item))) @@ -53,7 +51,7 @@ (defun delete-class-records (symbol-class &key where) (with-transaction (:database *claw-demo-db*) (let ((table-name (symbol-name (view-table (find-class symbol-class))))) - (delete-records :from table-name :where where)))) + (delete-records :from table-name :where where :database *claw-demo-db*))))
(defun build-order-by (fields) (loop for field in fields @@ -73,24 +71,32 @@ :flatp t :refresh refresh :offset offset - :limit limit) + :limit limit + :database *claw-demo-db*) (count-vo symbol-class :refresh refresh :where where :group-by group-by :having having)))
(defun count-vo (symbol-class &key (refresh t) where group-by having) "Returns the number of records matching the given criteria" - (first (select [count [*]] + (first (select (sql-operation 'count '*) :from (view-table (find-class symbol-class)) :where where :group-by group-by - :having having + :having having :flatp t - :refresh refresh))) + :refresh refresh + :database *claw-demo-db*)))
(defun find-by-id (symbol-class id) (first (select symbol-class :where (sql-operation '= (slot-column-name symbol-class 'id) id) :flatp t - :refresh t))) + :refresh t + :database *claw-demo-db*))) + +(defun delete-by-id (symbol-class id-list) + (first (delete-records :from (view-table (find-class symbol-class)) + :where (sql-operation 'in (slot-column-name symbol-class 'id) id-list) + :database *claw-demo-db*)))
(defmethod reload-db-item ((item base-table)) "Reloads item data selecting the item by its id. This function isn't destructive" @@ -103,7 +109,8 @@ (first (select 'user :where where :flatp t - :refresh t)))) + :refresh t + :database *claw-demo-db*))))
(defun find-customers (&key (offset 0) (limit *select-limit*) name1 name2 email vat phone sorting) (let ((where (remove-if #'null (list @@ -128,5 +135,3 @@ (apply #'sql-operation (cons 'and where)) (first where)) :order-by sorting))) - -#.(locally-disable-sql-reader-syntax) \ No newline at end of file
Modified: trunk/main/claw-demo/src/backend/setup.lisp ============================================================================== --- trunk/main/claw-demo/src/backend/setup.lisp (original) +++ trunk/main/claw-demo/src/backend/setup.lisp Thu Sep 18 09:31:55 2008 @@ -33,14 +33,14 @@ "The demo datebase")
(defun db-connect (&optional (connection-string '("127.0.0.1" "claw-demo" "claw-demo" "demo"))) - (setf *claw-demo-db* (connect connection-string :database-type :postgresql :pool t))) + (connect connection-string :database-type :postgresql :pool t))
-(defun db-disconnect () - (disconnect :database *claw-demo-db*)) +(defun db-disconnect (&optional (database *claw-demo-db*) ) + (disconnect :database database))
(defun create-claw-demo-tables () - (let ((*default-database* *claw-demo-db*)) + (let ((clsql:*default-database* *claw-demo-db*)) (create-view-from-class 'user-role) (create-view-from-class 'user) (create-view-from-class 'role) @@ -66,7 +66,7 @@ (symbol-name (view-table (find-class 'customer))))))))
(defun drop-claw-demo-tables () - (let ((*default-database* *claw-demo-db*) + (let ((clsql:*default-database* *claw-demo-db*) (user-role-table (symbol-name (view-table (find-class 'user-role)))) (customer-address-table (symbol-name (view-table (find-class 'customer-address))))) (dolist (table (list-tables)) @@ -75,7 +75,7 @@ (execute-command (format nil "DROP SEQUENCE ~a" sequence)))))
(defun demo-setup () - (db-connect) + (let ((*claw-demo-db* (db-connect))) (drop-claw-demo-tables) (create-claw-demo-tables) (with-transaction () @@ -103,4 +103,4 @@ :code1 (format nil "code2-~a" i) :code1 (format nil "code3-~a" i) :code1 (format nil "code4-~a" i)))))) - (db-disconnect)) \ No newline at end of file + (db-disconnect))) \ No newline at end of file
Modified: trunk/main/claw-demo/src/backend/vo.lisp ============================================================================== --- trunk/main/claw-demo/src/backend/vo.lisp (original) +++ trunk/main/claw-demo/src/backend/vo.lisp Thu Sep 18 09:31:55 2008 @@ -270,5 +270,9 @@ :foreign-key id :retrieval :immediate :set nil))) - (:default-initargs :address-type 0) + (:default-initargs :address-type 0 :address nil + :city nil + :zip nil + :state nil + :country nil) (:base-table customer-addresses))