;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: src/service.lisp $ ;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :claw-demo-backend) (defvar *select-limit* 1000000) (defgeneric update-db-item (base-table) (:documentation "Updates or inserts an item in a transaction aware context")) (defgeneric delete-db-item (base-table) (:documentation "Deletes an item in a transaction aware context")) (defgeneric reload-db-item (base-table) (:documentation "Reloads an item.")) (defmethod update-db-item ((item base-table)) (with-transaction (:database *claw-demo-db*) (update-records-from-instance item))) (defmethod delete-db-item ((item base-table)) (with-transaction (:database *claw-demo-db*) (delete-instance-records item))) (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 :database *claw-demo-db*)))) (defun build-order-by (fields) (loop for field in fields collect (if (listp field) (list (first field) (second field)) field))) (defun find-vo (symbol-class &key (offset 0) (limit *select-limit*) (refresh t) from where group-by having order-by (distinct t)) "Returns a pair of values where the first is the select result, and the second is the total record amount without considering offset and limit keys." (values (select symbol-class :from from :where where :group-by group-by :having having :order-by (when order-by (build-order-by order-by)) :flatp t :refresh refresh :offset offset :limit limit :distinct distinct :database *claw-demo-db*) (count-vo symbol-class :refresh refresh :from from :where where :group-by group-by :having having))) (defun count-vo (symbol-class &key (refresh t) from where group-by having (distinct t)) "Returns the number of records matching the given criteria" (first (select (sql-operation 'count '*) :from (or from (view-table (find-class symbol-class))) :where where :group-by group-by :having having :flatp t :refresh refresh :distinct distinct :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 :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" (let ((symbol-class (class-name (class-of item))) (id (table-id item))) (find-by-id symbol-class id))) (defun find-user-by-name (name) (let* ((where (sql-operation '= (slot-column-name 'user 'username) name)) (user (first (select 'user :where where :flatp t :refresh t :database *claw-demo-db*)))) user)) (defun find-customers (&key (offset 0) (limit *select-limit*) name1 name2 email vat phone sorting) (let ((where (remove-if #'null (list (when name1 (like-operation (slot-column-name 'customer 'name1) name1)) (when name2 (like-operation (slot-column-name 'customer 'name2) name2)) (when email (like-operation (slot-column-name 'customer 'email) email)) (when vat (sql-operation '= (slot-column-name 'customer 'vat) vat)) (when phone (sql-operation '= (slot-column-name 'customer 'phone1) phone)))))) (find-vo 'customer :offset offset :limit limit :where (if (> (length where) 1) (apply #'sql-operation (cons 'and where)) (first where)) :order-by sorting))) (clsql-sys:locally-enable-sql-reader-syntax) (defun find-users (&key (offset 0) (limit *select-limit*) surname firstname email username (active :any) role-names sorting) (let ((where (remove-if #'null (list (when surname (like-operation (sql-slot-value 'user 'surname) surname)) (when firstname (like-operation (sql-slot-value 'user 'firstname) firstname)) (when username (like-operation (sql-slot-value 'user 'username) firstname)) (when email (like-operation (sql-slot-value 'user 'email) email)) (unless (eql active :any) (sql-operation '= (sql-slot-value 'user 'active) active)) (when role-names (sql-operation 'in (sql-slot-value 'role 'name) role-names)))))) (find-vo 'user :offset offset :limit limit :from (sql-left-join (sql-left-join (view-table (find-class 'user)) (view-table (find-class 'user-role)) (sql-operation '= (sql-slot-value 'user 'id) (sql-slot-value 'user-role 'user-id))) (view-table (find-class 'role)) (sql-operation '= (sql-slot-value 'user-role 'role-id) (sql-slot-value 'role 'id))) :where (if (> (length where) 1) (apply #'sql-operation (cons 'and where)) (first where)) :order-by sorting))) (defun find-roles-by-names (&key (offset 0) (limit *select-limit*) names) (if (null names) (values nil 0) (find-vo 'role :offset offset :limit limit :where (sql-operation 'in (slot-value 'role 'name) names)))) (defun find-roles-by-ids (&key (offset 0) (limit *select-limit*) ids) (if (null ids) (values nil 0) (find-vo 'role :offset offset :limit limit :where (sql-operation 'in 'id ids)))) (clsql-sys:locally-disable-sql-reader-syntax)