Author: achiumenti Date: Tue Aug 26 06:57:00 2008 New Revision: 72 Added: trunk/main/claw-demo/ trunk/main/claw-demo/claw-demo.asd trunk/main/claw-demo/src/ trunk/main/claw-demo/src/backend/ 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 trunk/main/claw-demo/src/frontend/ trunk/main/claw-demo/src/frontend/auth.lisp trunk/main/claw-demo/src/frontend/commons.lisp trunk/main/claw-demo/src/frontend/customers.lisp trunk/main/claw-demo/src/frontend/docroot/ trunk/main/claw-demo/src/frontend/docroot/css/ trunk/main/claw-demo/src/frontend/docroot/css/style.css trunk/main/claw-demo/src/frontend/docroot/img/ trunk/main/claw-demo/src/frontend/docroot/img/bg.png (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/img/claw.png (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/img/clawDemo.png (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/img/clawHead.png (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/img/roundedbg.gif (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/img/roundedbg.png (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/img/spinner.gif (contents, props changed) trunk/main/claw-demo/src/frontend/docroot/spinner.gif (contents, props changed) trunk/main/claw-demo/src/frontend/index.lisp trunk/main/claw-demo/src/frontend/login.lisp trunk/main/claw-demo/src/frontend/logout.lisp trunk/main/claw-demo/src/frontend/main.lisp trunk/main/claw-demo/src/frontend/packages.lisp trunk/main/claw-demo/test/ Log: CLAW demo application Added: trunk/main/claw-demo/claw-demo.asd ============================================================================== --- (empty file) +++ trunk/main/claw-demo/claw-demo.asd Tue Aug 26 06:57:00 2008 @@ -0,0 +1,74 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: claw-demo.asd $ + +;;; 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. + +(asdf:defsystem :claw-demo-test-backend + :components ((:module "test" + :components ((:module backend + :components ((:file "tests")))))) + :depends-on (:claw-demo-backend :lift)) + +(asdf:defsystem :claw-demo-backend + :name "claw-demo-backend" + :author "Andrea Chiumenti" + :description "Demo application for claw, backend part." + :depends-on (:clsql :clsql-postgresql :local-time :claw :closer-mop :split-sequence) + :components ((:module src + :components ((:module backend + :components ((:file "packages") + (:file "vo" :depends-on ("packages")) + (:file "setup" :depends-on ("packages" "vo")) + (:file "dao" :depends-on ("vo" "setup")) + (:file "service" :depends-on ("dao")))))))) + +(asdf:defsystem :claw-demo-frontend + :name "claw-demo-frontend" + :author "Andrea Chiumenti" + :description "Demo application for claw, frontend part." + :depends-on (:local-time :claw :hunchentoot-connector :claw-html :claw-html.dojo :claw-demo-backend) + :components ((:module src + :components ((:module frontend + :components ((:file "packages") + (:file "auth" :depends-on ("packages")) + (:file "commons" :depends-on ("packages")) + (:file "main" :depends-on ("packages" "auth")) + (:file "index" :depends-on ("commons" "main")) + (:file "logout" :depends-on ("commons" "main")) + (:file "login" :depends-on ("commons" "main")) + (:file "customers" :depends-on ("commons" "main")))))))) + + +(asdf:defsystem :claw-demo + :name "claw-demo" + :author "Andrea Chiumenti" + :description "Demo application for claw." + :in-order-to ((test-op (load-op :claw-demo-test-backend))) + :perform (test-op :after (op c) + (describe (funcall (find-symbol "RUN-TESTS" "LIFT") + :suite (find-symbol "CLAW-DEMO-BACKEND-TESTSUITE" "CLAW-DEMO-BACKEND")))) + :depends-on (:clsql :clsql-postgresql :local-time :claw :closer-mop :claw-demo-backend :claw-demo-frontend)) Added: trunk/main/claw-demo/src/backend/dao.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/backend/dao.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,166 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/dao.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) + +(defgeneric check-instance-version (base-table &key database) + (:documentation "Versioning support for base-table instances")) + +(defgeneric sign-table-update (base-table) + (:documentation "Set insert/modify user and date to the given record")) + + +(defgeneric local-time-to-timestamp (local-time)) + +(defmethod local-time-to-timestamp ((local-time local-time)) + (with-decoded-local-time (:sec sec :minute minute :hour hour :day day :month month :year year) + local-time + (make-time + :year year :month month :day day :hour hour :minute minute :second sec))) + +(defmethod sign-table-update ((base-table base-table)) + (let ((user-name (or (and *clawserver* + (current-principal) + (principal-name (current-principal))) + "anonymous")) + (now-timestamp (local-time-to-timestamp (now)))) + (when (null (table-insert-user base-table)) + (setf (table-insert-user base-table) user-name + (table-insert-date base-table) now-timestamp)) + (setf (table-update-user base-table) user-name + (table-update-date base-table) now-timestamp))) + + +(defun slot-column-name (symbol-class slot-name) + (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*)) + (let* ((instance-version (table-version instance)) + (table (view-table (class-of instance))) + (instance-id (table-id instance)) + (version (first (select [version] + :from table + :where [= [id] instance-id] + :flatp t + :refresh t + :database database)))) + (when (and version (not (= version instance-version))) + (error "Wrong version number (given ~d , expected ~d) for record id ~d on table ~a" + instance-version + version + instance-id + table)))) + +(defmethod delete-instance-records :before ((instance base-table)) + (check-instance-version instance :database (clsql-sys::view-database instance))) + + + +(defmethod update-records-from-instance :before ((instance base-table) &key (database *default-database*)) + (check-instance-version instance :database database) + (sign-table-update instance) + (if (and (slot-boundp instance 'id) (not (null (table-id instance)))) + (incf (table-version instance)) + (unless (typep instance 'base-table-121) + (let ((sequence-name (format nil + "~a_id_seq" + (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*)) + (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))) + (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))) + (when id + (delete-records :from [customer-addresses] :where [= [customer-id] id])))) + +(defmethod update-records-from-instance :after ((instance customer) &key (database *default-database*)) + (let ((id (table-id instance))) + (dolist (address (customer-addresses instance)) + (setf (customer-address-customer-id address) id) + (update-records-from-instance address)))) + +(defmethod delete-instance-records :before ((instance user)) + (let ((id (table-id instance))) + (when id + (delete-records :from [users-roles] :where [= [user-id] id])))) + + +(defmethod delete-instance-records :before ((instance customer)) + (let ((id (table-id instance))) + (when id + (delete-records :from [customer-addresses] :where [= [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])))) + +(defun like-operation (name value &key (insensitive t) (wild-char #\*)) + (setf value (format nil "~{~A~^\\\\~}" (split-sequence #\\ value))) + (unless (eql wild-char #\%) + (setf value (format nil "~{~A~^\\%~}" (split-sequence #\% value)))) + (let ((v (if (eql wild-char #\%) + value + (substitute #\% wild-char value))) + (result)) + (setf result (sql-operation 'LIKE + (if insensitive + (sql-operation 'UPPER name) + name) + (if insensitive + (sql-operation 'UPPER v) + v))) + result)) + +#.(locally-disable-sql-reader-syntax) \ No newline at end of file Added: trunk/main/claw-demo/src/backend/packages.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/backend/packages.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,102 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/package.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 :cl-user) + + +(defpackage :claw-demo-backend + (:use :cl :clsql :clsql-postgresql :local-time :claw :closer-mop :split-sequence) + (:shadowing-import-from :local-time + :timezone + :decode-duration + :format-duration + :parse-datestring + :universal-time + :parse-timestring) + (:documentation "A demo application for CLAW") + (:export #:demo-setup + #:db-connect + #:db-disconnect + ;; --- Value objects --- ;; + #:base-table + #:table-id + #:table-version + #:table-update-user + #:table-insert-user + #:table-update-date + #:table-insert-date + #:user + #:user-firstname + #:user-surname + #:user-username + #:user-email + #:user-password + #:user-active + #:user-roles + #:role + #:role-name + #:role-description + #:role-users + #:city + #:city-name + #:city-zip + #:city-iso-state + #:city-iso-country + #:city-alt-code + #:customer + #:customer-name1 + #:customer-name2 + #:customer-email + #:customer-phone1 + #:customer-phone2 + #:customer-phone3 + #:customer-fax + #:customer-addresses + #:customer-vat + #:customer-vat + #:customer-code1 + #:customer-code2 + #:customer-code3 + #:customer-code4 + #:customer-address + #:customer-address-name1 + #:customer-address-name2 + #:customer-address-address-type + #:customer-address-address + #:customer-address-city + #:customer-address-zip + #:customer-address-state + #:customer-address-country + ;; --- Business methods --- ;; + #:update-db-item + #:delete-db-item + #:reload-db-item + #:delete-class-records + #:find-user-by-name + #:find-customers)) \ No newline at end of file Added: trunk/main/claw-demo/src/backend/service.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/backend/service.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,121 @@ +;;; -*- 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.")) + +#.(locally-enable-sql-reader-syntax) + +(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)))) + +(defun find-vo (symbol-class &key (offset 0) (limit *select-limit*) (refresh t) where group-by having order-by) + "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 + :where where + :group-by group-by + :having having + :order-by order-by + :flatp t + :refresh refresh + :offset offset + :limit limit) + (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 [*]] + :from (view-table (find-class symbol-class)) + :where where + :group-by group-by + :having having + :flatp t + :refresh refresh))) + +(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))) + (first (select symbol-class + :where [= [slot-value symbol-class 'id] id] + :flatp t + :refresh t)))) + +(defun find-user-by-name (name) + (let ((where (sql-operation '= (slot-column-name 'user 'username) name))) + (first (select 'user + :where where + :flatp t + :refresh t)))) + +(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))))) + +#.(locally-disable-sql-reader-syntax) \ No newline at end of file Added: trunk/main/claw-demo/src/backend/setup.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/backend/setup.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,106 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/setup.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 *claw-demo-db* nil + "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))) + +(defun db-disconnect () + (disconnect :database *claw-demo-db*)) + + +(defun create-claw-demo-tables () + (let ((*default-database* *claw-demo-db*)) + (create-view-from-class 'user-role) + (create-view-from-class 'user) + (create-view-from-class 'role) + (let ((user-role-table (symbol-name (view-table (find-class 'user-role))))) + (execute-command (format nil "ALTER TABLE ~a ADD CONSTRAINT ~a_fk1 FOREIGN KEY (~a) REFERENCES ~a (id) ON DELETE CASCADE" + user-role-table + user-role-table + (slot-column-name 'user-role 'user-id) + (symbol-name (view-table (find-class 'user))))) + (execute-command (format nil "ALTER TABLE ~a ADD CONSTRAINT ~a_fk2 FOREIGN KEY (~a) REFERENCES ~a (id) ON DELETE CASCADE" + user-role-table + user-role-table + (slot-column-name 'user-role 'role-id) + (symbol-name (view-table (find-class 'role)))))) + (create-view-from-class 'city) + (create-view-from-class 'customer) + (create-view-from-class 'customer-address) + (let ((customer-address-table (symbol-name (view-table (find-class 'customer-address))))) + (execute-command (format nil "ALTER TABLE ~a ADD CONSTRAINT ~a_fk1 FOREIGN KEY (~a) REFERENCES ~a (id) ON DELETE CASCADE" + customer-address-table + customer-address-table + (slot-column-name 'customer-address 'customer-id) + (symbol-name (view-table (find-class 'customer)))))))) + +(defun drop-claw-demo-tables () + (let ((*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)) + (execute-command (format nil "DROP TABLE ~a CASCADE" table))) + (dolist (sequence (list-sequences)) + (execute-command (format nil "DROP SEQUENCE ~a" sequence))))) + +(defun demo-setup () + (db-connect) + (drop-claw-demo-tables) + (create-claw-demo-tables) + (with-transaction () + (let ((admin-role (make-instance 'role :name "administrator")) + (user-role (make-instance 'role :name "user"))) + (update-db-item admin-role) + (update-db-item user-role) + (update-db-item (make-instance 'user :firstname "Andrea" + :surname "Chiumenti" + :username "admin" + :password "admin" + :email "admin@new.com" + :roles (list admin-role user-role))) + (loop for i from 1 to 400 + do (update-db-item (make-instance 'customer + :name1 (format nil "Andrea~a" i) + :name2 (format nil "Chiumenti~a" i) + :email (format nil "a~a.chiumenti@new.com" i) + :phone1 "+393900001" + :phone2 "+393900002" + :phone3 "+393900003" + :fax "+393900010" + :vat (format nil "9999999999-~a" i) + :code1 (format nil "code1-~a" i) + :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 Added: trunk/main/claw-demo/src/backend/vo.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/backend/vo.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,267 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/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) + +(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 nil + :version 0 + :update-user nil + :insert-user nil + :update-date nil + :insert-date nil)) + +(def-view-class base-table-121 (base-table) + ((id :db-kind :key + :accessor table-id + :initarg :id + :type integer + :db-constraints :not-null))) + +(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) + (users :db-kind :join + :accessor user-role-users + :db-info (:join-class user + :home-key user-id + :foreign-key id + :retrieval :immediate + :set t)) + (roles :db-kind :join + :accessor user-role-roles + :db-info (:join-class role + :home-key role-id + :foreign-key id + :retrieval :immediate + :set t))) + (:base-table users-roles)) + +(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 + :accessor user-roles + :db-info (:join-class user-role + :home-key id + :foreign-key user-id + :target-slot roles + :set t))) + (:default-initargs :active t) + (:base-table users)) + +(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 + :accessor role-users + :db-info (:join-class user-role + :home-key id + :foreign-key role-id + :target-slot users + :set t))) + (:default-initargs :description "") + (:base-table 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 :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) + (:base-table customer-addresses)) Added: trunk/main/claw-demo/src/frontend/auth.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/auth.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,63 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/auth.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-frontend) + +(defclass demo-principal (principal) + ((firstname :initarg :firstname + :accessor demo-principal-firstname) + (surname :initarg :surname + :accessor demo-principal-surname)) + (:default-initargs :firstname "" :surname "")) + +(defclass demo-configuration (configuration) + () + (:documentation "Authorization configuration for application +atuhentication and authorization management.")) + +(defmethod configuration-login ((configuration configuration)) + (multiple-value-bind (user password) + (if (eq (lisplet-authentication-type *claw-current-lisplet*) :basic) + (claw-authorization) + (values (claw-parameter "username") + (claw-parameter "password"))) + (unwind-protect + (progn + (log-message :info "ppppppppppppppp") + (db-connect) + (let ((user-vo (find-user-by-name user))) + (when (and user-vo (string= password (user-password user-vo))) + (log-message :info "----> ~a " (user-roles user-vo)) + (make-instance 'demo-principal + :name (user-username user-vo) + :firstname (user-firstname user-vo) + :surname (user-surname user-vo) + :roles (loop for role-vo in (user-roles user-vo) + collect (role-name (first role-vo))))))) + (db-disconnect)))) \ No newline at end of file Added: trunk/main/claw-demo/src/frontend/commons.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/commons.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,223 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/commons.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-frontend) + + + + +(defclass site-template (wcomponent) + ((title :initarg :title + :reader site-template-title) + (djconfig :initarg :djconfig + :reader site-template-djconfig)) + (:metaclass metacomponent) + (:default-initargs :djconfig nil)) + +(defclass redirect (wcomponent) + ((href :initarg :href + :reader redirect-href)) + (:metaclass metacomponent)) + +(defmethod htcomponent-instance-initscript ((redirect redirect)) + (ps:ps* `(location.replace ,(redirect-href redirect)))) + +(defmethod wcomponent-template ((redirect redirect)) + ($> "")) + +(defun current-site-template () + (claw-aux-request-value 'site-template)) + +(defmethod wcomponent-template ((site-template site-template)) + (let ((principal (current-principal))) + (html> + (head> + (title> (site-template-title site-template)) + (link> :href (format nil "~a/docroot/css/style.css" (build-lisplet-location *claw-current-lisplet*)) + :rel "stylesheet" + :type "text/css")) + (djbody> :is-debug "false" + :theme "soria" + :class "demo" + :djconfig (site-template-djconfig site-template) + (wcomponent-informal-parameters site-template) + (div> :class "topheader" + (div> :class "logoDemo") + (div> :class "logoClaw")) + (djtoolbar> :id "menuBar" :class "menuBar" + (djdrop-down-button> (span> "File") + (djmenu> + (djmenu-item> :id "loginMenu" + :render-condition #'(lambda () (null principal)) + :on-click (ps:ps* `(location.replace ,(format nil "~a/login.html" (build-lisplet-location *claw-current-lisplet*)))) + "Login") + (djmenu-item> :id "logoutMenu" + :render-condition #'(lambda () principal) + :on-click (ps:ps* `(location.replace ,(format nil "~a/logout.html" (build-lisplet-location *claw-current-lisplet*)))) + "Logout"))) + (djdrop-down-button> :render-condition #'(lambda () principal) + (span> "Anagraphics") + (djmenu> + (djmenu-item> :id "customersMenu" + :on-click (ps:ps* `(location.replace ,(format nil "~a/customers.html" (build-lisplet-location *claw-current-lisplet*)))) + "Customers") + (djmenu-item> :id "usersMenu" + :render-condition #'(lambda () (user-in-role-p '("admin"))) + "Users")))) + (div> :class "contentBody" + (htcomponent-body site-template)))))) + +(defclass db-page (page) + ()) + +(defmethod page-render :around ((db-page db-page)) + (let ((result)) + (unwind-protect (progn + (db-connect) + (setf result (call-next-method))) + (db-disconnect)) + result)) + + + +(defgeneric pager-count-pages (pager)) + +(defgeneric pager-current-page (pager)) + +(defgeneric pager-page-list (pager)) + +(defgeneric set-offset-value (pager page)) + +(defclass pager (wcomponent) + ((update-component-id :initarg :update-component-id + :accessor pager-update-component-id) + (class :initarg :class + :reader pager-class) + (page-size :initarg :page-size + :reader pager-page-size) + (visible-pages :initarg :visible-pages + :accessor pager-visible-pages) + (total-items :initarg :total-items + :accessor pager-total-items) + (first-item-offset :initarg :first-item-offset + :accessor pager-first-item-offset)) + (:metaclass metacomponent) + (:default-initargs :page-size 10 :visible-pages 10 :class "pager")) + +(defmethod wcomponent-template ((pager pager)) + (let ((total-items (pager-total-items pager)) + (page-size (pager-page-size pager)) + (page-list (pager-page-list pager)) + (current-page (pager-current-page pager)) + (count-pages (pager-count-pages pager)) + (id (htcomponent-client-id pager))) + (when (> total-items page-size) + (div> + :static-id id + :class (pager-class pager) + (wcomponent-informal-parameters pager) + + (when (> current-page 1) + (list (div> :class "button first" + (span> :on-click (set-offset-value pager 1) "first")) + (div> :class "button previous" + (span> :on-click (set-offset-value pager (1- current-page)) "previous")))) + (loop for page in page-list + collect (if (= page current-page) + (div> :class "current page" + (span> (format nil "~a" page))) + (div> :class "page" (span> :on-click (set-offset-value pager page) (format nil "~a" page))))) + (when (< current-page count-pages) + (list (div> :class "button next" + (span> :on-click (set-offset-value pager (1+ current-page)) "next")) + (div> :class "button last" + (span> :on-click (set-offset-value pager count-pages) "last")))))))) + +(defmethod htcomponent-class-initscripts ((pager pager)) + (let ((update-component-id (pager-update-component-id pager)) + (page-size (pager-page-size pager))) + (list + (ps:ps* `(defun pager-go-to (page) + (setf (slot-value (dojo.by-id ,update-component-id) 'value) (* (1- page) ,page-size)) + (defvar form-id (slot-value (slot-value (dojo.by-id ,update-component-id) 'form) 'id)) + (let ((form-el (or (dijit.by-id form-id) + (dojo.by-id form-id)))) + (.submit form-el))))))) + +(defmethod set-offset-value ((pager pager) page) + (ps:ps* `(pager-go-to ,page))) + +(defmethod pager-count-pages ((pager pager)) + (let ((page-size (pager-page-size pager)) + (total-items (pager-total-items pager))) + (count-pages page-size total-items))) + +(defun count-pages (page-size total-items) + (multiple-value-bind (pages rest) + (truncate total-items page-size) + (when (> rest 0) (incf pages)) + pages)) + +(defmethod pager-current-page ((pager pager)) + (let ((page-size (pager-page-size pager)) + (first-item-offset (pager-first-item-offset pager))) + (multiple-value-bind (page rest) + (truncate (1+ first-item-offset) page-size) + (when (> rest 0) (incf page)) + page))) + +(defmethod pager-page-list ((pager pager)) + (let ((current-page (pager-current-page pager)) + (count-pages (pager-count-pages pager)) + (visible-pages (pager-visible-pages pager)) + (pages-before-current-page) + (pages-after-current-page) + (result)) + (when (> current-page 1) + (setf pages-before-current-page + (reverse + (loop for page from (1- current-page) downto (max 1 (- current-page + (truncate visible-pages 2))) + collect page)))) + (when (< current-page count-pages) + (setf pages-after-current-page + (loop for page from (1+ current-page) to (min count-pages (+ (1- current-page) + (- visible-pages (length pages-before-current-page)))) + collect page))) + (setf result (append pages-before-current-page (list current-page) pages-after-current-page)) + (let ((result-length (length result)) + (first-result-page (first result))) + (if (< result-length visible-pages) + (append (reverse (loop for page from (1- first-result-page) downto (max 1 (- first-result-page (- visible-pages result-length))) + collect page)) result) + result)))) + +(defun null-when-empty (string) + (unless (string= string "") + string)) \ No newline at end of file Added: trunk/main/claw-demo/src/frontend/customers.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/customers.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,237 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: dojo/tests/customers.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-frontend) + +(defgeneric edit-customer-save (edit-customer)) + +(defclass edit-customer (wcomponent) + ((customer :initarg :customer + :accessor edit-customer-customer) + (on-before-submit :initarg :on-before-submit + :accessor on-before-submit) + (on-xhr-finish :initarg :on-xhr-finish + :accessor on-xhr-finish)) + (:metaclass metacomponent) + (:default-initargs :on-before-submit nil :on-xhr-finish nil :customer (make-instance 'customer))) + +(defmethod wcomponent-template ((obj edit-customer)) + (let ((id (htcomponent-client-id obj)) + (visit-object (edit-customer-customer obj))) + (djform> :static-id id + :class "customerForm" + :update-id id + :action 'edit-customer-save + :action-object obj + :on-before-submit (on-before-submit obj) + :on-xhr-finish (on-xhr-finish obj) + (cinput> :type "hidden" :visit-object visit-object + :accessor 'table-id) + (div> :class "label name1" + (span> "Name 1") + (djvalidation-text-box> :visit-object visit-object + :required "true" + :label "Name 1" + :accessor 'customer-name1)) + (div> :class "label name2" + (span> "Name 2") + (djvalidation-text-box> :visit-object visit-object + :label "Name 2" + :accessor 'customer-name2)) + (div> :class "label email" + (span> "Email") + (djvalidation-text-box> :visit-object visit-object + :label "Email" + :accessor 'customer-email)) + (div> :class "label pone1" + (span> "Phone 1") + (djvalidation-text-box> :visit-object visit-object + :label "Phone 1" + :accessor 'customer-phone1)) + (div> :class "label pone2" + (span> "Phone 2") + (djvalidation-text-box> :visit-object visit-object + :label "Phone 2" + :accessor 'customer-phone2)) + (div> :class "label pone3" + (span> "Phone 3") + (djvalidation-text-box> :visit-object visit-object + :label "Phone 3" + :accessor 'customer-phone3)) + (div> :class "label fax" + (span> "Fax") + (djvalidation-text-box> :visit-object visit-object + :label "Fax" + :accessor 'customer-fax)) + (div> :class "label vat" + (span> "VAT") + (djvalidation-text-box> :visit-object visit-object + :label "VAT" + :accessor 'customer-vat)) + (div> :class "label code1" + (span> "Code 1") + (djvalidation-text-box> :visit-object visit-object + :label "Code 1" + :accessor 'customer-code1)) + (div> :class "label code2" + (span> "Code 2") + (djvalidation-text-box> :visit-object visit-object + :label "Code 2" + :accessor 'customer-code2)) + (div> :class "label code3" + (span> "Code 3") + (djvalidation-text-box> :visit-object visit-object + :label "Code 3" + :accessor 'customer-code3)) + (div> :class "label code4" + (span> "Code 4") + (djvalidation-text-box> :visit-object visit-object + :label "Code 4" + :accessor 'customer-code4)) + (div> :class "buttons" + (djsubmit-button> :value "Save"))))) + +(defmethod edit-customer-save ((obj edit-customer)) + (let ((id (htcomponent-client-id obj))) + (handler-case + (update-db-item (edit-customer-customer obj)) + (error (cond) + (add-validation-error id cond))))) + +(defgeneric customers-page-find-users (customers-page)) + +(defgeneric customers-page-offset-reset (customers-page)) + +(defclass customers-page (db-page) + ((customers :initform nil + :accessor customers-page-customers) + (customers-total-count :initform 0 + :accessor customers-page-customers-total-count) + (list-size :initarg :list-size + :accessor customers-page-list-size) + (offset :initform 0 + :accessor customers-page-offset) + (name1 :initform "" + :accessor customers-page-name1) + (name2 :initform "" + :accessor customers-page-name2) + (email :initform "" + :accessor customers-page-email) + (vat :initform "" + :accessor customers-page-vat) + (phone :initform "" + :accessor customers-page-phone)) + (:default-initargs :list-size 20)) + +(defmethod customers-page-offset-reset ((page customers-page)) 0) + +(defmethod page-content ((page customers-page)) + (let ((spinner-id (generate-id "spinner")) + (form-id (generate-id "customersForm")) + (customers (customers-page-customers page)) + (offset-id (generate-id "offset"))) + (site-template> :title "CLAW Demo anagraphics" + (djfloating-content> :static-id spinner-id + (img> :alt "spinner" + :src "docroot/img/spinner.gif")) + (djform> :static-id form-id + :action 'customers-page-find-users + :update-id form-id + :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id))) + :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id))) + (div> (div> :class "searchParameters hlist" + (div> :class "item" (span> :class "name1" "Name") + (djtext-box> :label "name" :id "name1" :accessor 'customers-page-name1) + (djtext-box> :label "name" :id "name2" :accessor 'customers-page-name2)) + (div> :class "item" (span> :class "email" "Email") + (djtext-box> :label "email" :id "email" :accessor 'customers-page-email)) + (div> :class "item" (span> :class "vat" "VAT") + (djtext-box> :label "vat" :id "vat" :accessor 'customers-page-vat)) + (div> :class "item" (span> :class "phone" "phone") + (djtext-box> :label "phone" :id "phone" :accessor 'customers-page-phone))) + (cinput> :type "hidden" + :static-id offset-id + :translator *integer-translator* + :reader 'customers-page-offset-reset + :writer (attribute-value '(setf customers-page-offset))) + (djsubmit-button> :id "search" + :value "Search")) + (table> :class "listTable" + (tr> :class "header" + (th> :class "name" "Name") + (th> :class "email" "Email") + (th> :class "vat" "VAT") + (th> :class "phone" "Phone")) + (loop for customer in customers + for index = 0 then (incf index) + collect (tr> :class (if (evenp index) "item even" "item odd") + (td> (customer-name1 customer) + " " + (customer-name2 customer)) + (td> (customer-email customer)) + (td> (customer-vat customer)) + (td> (customer-phone1 customer))))) + (pager> :id "pager" + :update-component-id offset-id + :page-size (customers-page-list-size page) + :total-items (customers-page-customers-total-count page) + :first-item-offset (customers-page-offset page)))))) + +(defmethod customers-page-find-users ((page customers-page)) + (let ((name1 (customers-page-name1 page)) + (name2 (customers-page-name2 page)) + (email (customers-page-email page)) + (vat (customers-page-vat page)) + (phone (customers-page-phone page))) + (multiple-value-bind (customers total-size) + (find-customers :offset (customers-page-offset page) + :limit (customers-page-list-size page) + :name1 (null-when-empty name1) + :name2 (null-when-empty name2) + :email (null-when-empty email) + :vat (null-when-empty vat) + :phone (null-when-empty phone)) + (setf (customers-page-customers page) customers + (customers-page-customers-total-count page) total-size)))) + +(defmethod page-before-render ((page customers-page)) + (unless (page-req-parameter page *rewind-parameter*) + (multiple-value-bind (customers total-size) + (find-customers :offset 0 + :limit (customers-page-list-size page)) + (setf (customers-page-customers page) customers + (customers-page-customers-total-count page) total-size)))) + + +(lisplet-register-function-location *dojo-demo-lisplet* + (make-page-renderer 'customers-page #'claw-post-parameters #'claw-get-parameters) + "customers.html") + +(lisplet-protect *dojo-demo-lisplet* "customers.html" '("administrator" "user")) + Added: trunk/main/claw-demo/src/frontend/docroot/css/style.css ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/docroot/css/style.css Tue Aug 26 06:57:00 2008 @@ -0,0 +1,120 @@ +body.demo { + width: 1000px; + margin: 0 auto; + padding: 0 100px; + background: #14335C url('../img/bg.png') repeat-x scroll 0 0; + font-family: arial; +} + +.contentBody { + margin-top: 0; + background: white; + min-height: 450px; + padding: 10px; +} + +.contentBody ul { + margin: 0; +} + +p.header { + background: #9CBBE5; + padding: .5em; + margin-top:0; +} + +.unclosable .dijitDialogCloseIcon { + display: none; +} + +.dialogLabel { + width: 80px; + text-align: right; + display:-moz-inline-stack; + display:inline-block; +} + +.buttonContainer { + margin-top: 1em; + border-top: 1px solid #BDD6F0; + padding-top: .5em; + text-align: center; +} + +#exceptionMonitor ul { + list-style-type: none; + color: red; +} + +.topheader { + position: relative; + height: 140px; + background: url(../img/clawHead.png) 0 0 no-repeat; + z-index: 100; +} + +.logoDemo { + position: absolute; + top: 35px; + background: url(../img/clawDemo.png) 0 0 no-repeat; + height: 106px; + width: 301px; + margin-left: 700px; + z-index: 200; +} + +.topheader .logoClaw { + position: absolute; + top: 5px; + background: url(../img/claw.png) 0 0 no-repeat; + height: 123px; + width: 123px; + margin-left:20px; + z-index: 300; +} + +.soria .listTable { + width: 100%; + border-collapse: collapse; +} + +.soria .listTable .header { + background:#EAEAEA; + border-bottom:1px solid #CCCCCC; +} + +.soria .listTable .header th { + padding:3px 0 1px 3px; +} + + +.pager { + text-align: center; +} + +.pager div { + display:-moz-inline-stack; + display:inline-block; + cursor: pointer; +} + +.pager div.page { + width: 20px; +} + +.pager div.button { + padding-left: 3px; + padding-right: 3px; +} + +.pager div.current { + cursor: default; + font-weight: bold; +} + +.hlist div.item { + float: left; +} +.searchParameters div.item span { + display: block; +} \ No newline at end of file Added: trunk/main/claw-demo/src/frontend/docroot/img/bg.png ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/img/claw.png ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/img/clawDemo.png ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/img/clawHead.png ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/img/roundedbg.gif ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/img/roundedbg.png ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/img/spinner.gif ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/docroot/spinner.gif ============================================================================== Binary file. No diff available. Added: trunk/main/claw-demo/src/frontend/index.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/index.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,58 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: dojo/tests/index.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-frontend) + + +(defclass index-page (page) + ((username :initform nil + :accessor index-page-username) + (passwd :initform nil + :accessor index-page-password))) + +(defmethod page-content ((o index-page)) + (site-template> :title "Home test page" + (ul> + (li> (a> :href "index.html" "Home")) + (li> (a> :href "info.html" "HTTP Header info")) + (li> (a> :href "realm.html" "realm on test")) + (li> (a> :href "../test2/realm.html" "realm on test2")) + (li> (a> :href "djbutton.html" "dojo buttons integration test")) + (li> (a> :href "djdialog.html" "dojo dialog integration test")) + (li> (a> :href "djcolorpalette.html" "dojo color palette integration test")) + (li> (a> :href "djeditor.html" "dojo editor integration test")) + (li> (a> :href "ajax.html" "dojo ajax test")) + (li> (a> :href "djcalendar.html" "dojo calendar test")) + (li> (a> :href "slider.html" "dojo slider test")) + (li> (a> :href "djmenu.html" "dojo menu test"))))) + +(lisplet-register-function-location *dojo-demo-lisplet* + (make-page-renderer 'index-page #'claw-post-parameters #'claw-get-parameters) + "index.html" + :welcome-page-p t) \ No newline at end of file Added: trunk/main/claw-demo/src/frontend/login.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/login.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,86 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: dojo/tests/login.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-frontend) + +(defgeneric login-page-do-login (login-page)) + +(defclass login-page (page) + ((username :initform "" + :accessor login-page-username) + (passwd :initform "" + :accessor login-page-password))) + +(defmethod page-content ((o login-page)) + (let ((login-result-id (generate-id "loginResult")) + (spinner-id (generate-id "spinner"))) + (site-template> :title "CLAW Demo login" + (djdialog> :id "loginDialog" + :title "Login into system" + :class "unclosable" + (djfloating-content> :static-id spinner-id + (img> :alt "spinner" + :src "docroot/img/spinner.gif")) + (djform> :id "login" + :class "loginForm" + :action 'login-page-do-login + :update-id login-result-id + :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id))) + :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id))) + (div> + (span> :class "dialogLabel" "Username") + (djvalidation-text-box> :id "username" + :label "Username" + :required "true" + :accessor 'login-page-username)) + (div> + (span> :class "dialogLabel" "Password") + (djvalidation-text-box> :id "password" + :label "Password" + :required "true" + :accessor 'login-page-password)) + (div> :class "buttonContainer" + (djsubmit-button> :value "Login") + (exception-monitor> :id "exceptionMonitor"))) + (div> :static-id login-result-id + (redirect> :render-condition #'current-principal + :id "redirect" + :href (format nil "~a/index.html" (build-lisplet-location *claw-current-lisplet*))))) + (script> (ps:ps* `(dojo.add-on-load (lambda () (.show (dijit.by-id "loginDialog"))))))))) + +(lisplet-register-function-location *dojo-demo-lisplet* + (make-page-renderer 'login-page #'claw-post-parameters #'claw-get-parameters) + "login.html" + :login-page-p t) + +(defmethod login-page-do-login ((page login-page)) + (log-message :error "Performing login") + (unless (login) + (add-validation-error "login" + "Invalid user or password"))) \ No newline at end of file Added: trunk/main/claw-demo/src/frontend/logout.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/logout.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,46 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: dojo/tests/logout.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-frontend) + +(defgeneric do-logout (page)) + +(defclass logout-page (page) + ()) + +(defmethod page-content ((o logout-page)) + (do-logout o)) + +(defmethod do-logout ((demo-page logout-page)) + (claw-remove-session) + (claw-redirect (format nil "~a/index.html" (build-lisplet-location *claw-current-lisplet*)) :protocol :http)) + +(lisplet-register-function-location *dojo-demo-lisplet* + (make-page-renderer 'logout-page #'claw-post-parameters #'claw-get-parameters) + "logout.html") \ No newline at end of file Added: trunk/main/claw-demo/src/frontend/main.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/main.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,74 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: dojo/tests/main.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-frontend) + + +(defvar *main-file* (load-time-value + (or #.*compile-file-pathname* *load-pathname*))) + +(defvar *dojo-demo-lisplet*) + +(setf *dojo-demo-lisplet* (make-instance 'lisplet :realm "demo" + :redirect-protected-resources-p t + :base-path "/demo")) + +(defvar *ht-connector* (make-instance 'hunchentoot-connector + :port 4242 + :sslport nil + :behind-apache-p t + :mod-lisp-p nil)) + +(defvar *sm* (make-instance 'default-session-manager)) + +(defvar *ht-log-manager* (make-instance 'hunchentoot-logger)) + +(defvar *dojo-clawserver* (make-instance 'clawserver + :connector *ht-connector* + :log-manager *ht-log-manager* + :session-manager *sm* + :base-path "/claw")) + +(clawserver-register-lisplet *dojo-clawserver* *dojo-demo-lisplet*) + +(clawserver-register-configuration *dojo-clawserver* "demo" (make-instance 'demo-configuration)) + +(let ((path (make-pathname :directory (append (pathname-directory *main-file*) '("docroot")))) + (*clawserver* *dojo-clawserver*)) + (log-message :info "Registering resource ~a" path) + (lisplet-register-resource-location *dojo-demo-lisplet* + path + "docroot/")) + +(defun djstart () + (clawserver-start *dojo-clawserver*)) + +(defun djstop () + (clawserver-stop *dojo-clawserver*)) + Added: trunk/main/claw-demo/src/frontend/packages.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/packages.lisp Tue Aug 26 06:57:00 2008 @@ -0,0 +1,36 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/package.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 :cl-user) + + +(defpackage :claw-demo-frontend + (:use :cl :local-time :claw :hunchentoot-connector :claw-html :claw-html.dojo :claw-demo-backend) + (:documentation "A demo application for CLAW") + #|(:export #:demo-setup)|#) \ No newline at end of file