;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: src/backend/vo.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) (defmacro copy-values-by-accessors (dest src &rest accessors) (let ((dest-src-pairs (loop for accessor in accessors collect `(,accessor ,dest) collect `(,accessor ,src)))) `(setf ,@dest-src-pairs))) (defgeneric records-equal (base-table base-table)) (def-view-class base-table () ((id :db-kind :key :accessor table-id :initarg :id :type integer :db-type "serial" :db-constraints :not-null) (version :accessor table-version :initarg :version :type integer :db-constraints :not-null) (update-user :accessor table-update-user :initarg :update-user :type (varchar 80)) (insert-user :accessor table-insert-user :initarg :insert-user :type (varchar 80)) (update-date :accessor table-update-date :initarg :update-date :type wall-time) (insert-date :accessor table-insert-date :initarg :insert-date :type wall-time)) (:default-initargs :id 0 :version 0 :update-user nil :insert-user nil :update-date nil :insert-date nil)) (defmethod records-equal ((o1 base-table) (o2 base-table)) (and (equal (type-of o1) (type-of o2)) (= (table-id o1) (table-id o2)))) (def-view-class base-table-121 () ()) (def-view-class user-role () ((user-id :db-kind :key :initarg :user-id :accessor user-role-user-id :type integer :db-constraints :not-null) (role-id :db-kind :key :initarg :role-id :accessor user-role-role-id :type integer :db-constraints :not-null) (user :db-kind :join :accessor user-role-user :db-info (:join-class user :home-key user-id :foreign-key id :retrieval :immediate :set nil )) (role :db-kind :join :accessor user-role-role :db-info (:join-class role :home-key role-id :foreign-key id :retrieval :immediate :set nil ))) (:base-table users-roles)) (defgeneric user-roles (user)) (def-view-class user (base-table) ((firstname :initarg :firstname :accessor user-firstname :type (varchar 80) :db-constraints :not-null) (surname :initarg :surname :accessor user-surname :type (varchar 80) :db-constraints :not-null) (username :initarg :username :accessor user-username :type (varchar 80) :db-constraints :not-null) (email :initarg :email :accessor user-email :type (varchar 200) :db-constraints :not-null) (password :initarg :password :accessor user-password :type (varchar 100) :db-constraints :not-null) (active :initarg :active :accessor user-active :type boolean :db-constraints :not-null) (roles :db-kind :join :initarg :roles :writer (setf user-roles) :db-info (:join-class user-role :home-key id :foreign-key user-id :target-slot role :set t))) (:default-initargs :firstname nil :surname nil :username nil :email nil :password nil :active t ) (:base-table users)) (defmethod user-roles ((user user)) (loop for role-users-roles in (slot-value user 'roles) collect (if (listp role-users-roles) (first role-users-roles) role-users-roles))) (defgeneric role-users (role)) (def-view-class role (base-table) ((name :initarg :name :accessor role-name :type (varchar 20) :db-constraints :not-null) (description :initarg :description :accessor role-description :type (varchar 200)) (users :db-kind :join :writer (setf role-users) :db-info (:join-class user-role :home-key id :foreign-key role-id :target-slot user :set t))) (:default-initargs :description "") (:base-table roles)) (defmethod role-users ((role role)) (loop for user-users-roles in (slot-value role 'users) collect (if (listp user-users-roles) (first user-users-roles) user-users-roles))) (def-view-class city (base-table) ((city-name :initarg :name :accessor city-name :type (varchar 120) :db-constraints :not-null) (zip :initarg :zip :accessor city-zip :type (string 5) :db-constraints :not-null) (iso-state :initarg :iso-state :accessor city-iso-state :type (string 5)) ;ISO_3166-2 (iso-country :initarg :isocountry :accessor city-iso-country :type (string 3)) ;ISO_3166-1 Alpha-3 (alt-code :initarg :alt-code :accessor city-alt-code :type (varchar 50))) (:default-initargs :iso-state nil :iso-country nil :alt-code nil) (:base-table cities)) (def-view-class customer (base-table) ((name1 :initarg :name1 :accessor customer-name1 :type (varchar 150) :db-constraints :not-null) (name2 :initarg :name2 :accessor customer-name2 :type (varchar 80)) (email :initarg :email :accessor customer-email :type (varchar 200)) (phone1 :initarg :phone1 :accessor customer-phone1 :type (varchar 25)) (phone2 :initarg :phone2 :accessor customer-phone2 :type (varchar 25)) (phone3 :initarg :phone3 :accessor customer-phone3 :type (varchar 25)) (fax :initarg :fax :accessor customer-fax :type (varchar 25)) (addresses :db-kind :join :initarg :addresses :accessor customer-addresses :db-info (:join-class customer-address :home-key id :foreign-key customer-id :retrieval :deferred :set t)) (vat :initarg :vat :accessor customer-vat :type (varchar 50) :db-constraints :unique) (code1 :initarg :code1 :accessor customer-code1 :type (varchar 50) :db-constraints :unique) (code2 :initarg :code2 :accessor customer-code2 :type (varchar 50) :db-constraints :unique) (code3 :initarg :code3 :type (varchar 50) :accessor customer-code3 :db-constraints :unique) (code4 :initarg :code4 :accessor customer-code4 :type (varchar 50) :db-constraints :unique)) (:default-initargs :name1 nil :name2 nil :email nil :phone1 nil :phone2 nil :phone3 nil :fax nil :vat nil :code1 nil :code2 nil :code3 nil :code4 nil) (:base-table customers)) (def-view-class customer-address (base-table) ((address-type :initarg :address-type :accessor customer-address-type :type integer :db-constraints :not-null) (address :initarg :address :accessor customer-address-address :type (varchar 200) :db-constraints :not-null) (city :initarg :city :accessor customer-address-city :type (varchar 120) :db-constraints :not-null) (zip :initarg :zip :accessor customer-address-zip :type (string 5) :db-constraints :not-null) (state :initarg :state :accessor customer-address-state :type (varchar 120) :db-constraints :not-null) (country :initarg :country :accessor customer-address-country :type (varchar 80) :db-constraints :not-null) (customer-id :initarg :customer-id :accessor customer-address-customer-id :type integer :db-constraints :not-null) (customer :initarg :customer :db-info (:join-class customer :home-key customer-id :foreign-key id :retrieval :immediate :set nil))) (:default-initargs :address-type 0 :address nil :city nil :zip nil :state nil :country nil) (:base-table customer-addresses))