Author: achiumenti Date: Fri Jan 25 06:30:05 2008 New Revision: 4 Modified: trunk/main/claw-core/claw.asd trunk/main/claw-core/src/lisplet.lisp trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/tests/test1.lisp Log: modified lisplet-register-resource-location to handle static file other then folders added lisplet-register-function-location to register functions to a lisplet Modified: trunk/main/claw-core/claw.asd ============================================================================== --- trunk/main/claw-core/claw.asd (original) +++ trunk/main/claw-core/claw.asd Fri Jan 25 06:30:05 2008 @@ -31,7 +31,7 @@ :name "claw" :author "Andrea Chiumenti" :description "Common Lisp Active Web.A famework to write web applications" - :depends-on (:hunchentoot :alexandria :cl-ppcre) + :depends-on (:hunchentoot :alexandria :cl-ppcre :cl-fad) :components ((:module src :components ((:file "packages") (:file "misc" :depends-on ("packages")) Modified: trunk/main/claw-core/src/lisplet.lisp ============================================================================== --- trunk/main/claw-core/src/lisplet.lisp (original) +++ trunk/main/claw-core/src/lisplet.lisp Fri Jan 25 06:30:05 2008 @@ -31,8 +31,10 @@ ;(print *this-file*) +(defgeneric lisplet-register-function-location (obj function location &optional welcome-pagep)) (defgeneric lisplet-register-page-location (obj page-class location &optional welcome-pagep)) -(defgeneric lisplet-register-resource-location (obj uri url)) + +(defgeneric lisplet-register-resource-location (obj uri url &optional content-type)) (defgeneric lisplet-dispatch-request (obj)) (defgeneric lisplet-dispatch-method (obj)) @@ -61,7 +63,21 @@ (setf location (format nil "~a~a" server-base-path location))) location)) -(defmethod lisplet-register-page-location ((obj lisplet) page-class location &optional welcome-pagep) +(defmethod lisplet-register-function-location ((obj lisplet) function location &optional welcome-pagep) + (let ((pages (lisplet-pages obj)) + (new-location (build-lisplet-location obj location))) + (setf (lisplet-pages obj) + (sort-dispatchers (push-dispatcher + (cons new-location + (create-prefix-dispatcher new-location + function + (lisplet-realm obj))) + pages))) + (when welcome-pagep + (setf (lisplet-welcome-page obj) new-location)))) + +#| +(defmethod lisplet-register-page-location ((obj lisplet) page-class location &optional welcome-pagep content-type) (let ((pages (lisplet-pages obj)) (new-location (build-lisplet-location obj location))) (setf (lisplet-pages obj) @@ -72,18 +88,32 @@ (with-output-to-string (*standard-output*) (page-render (make-instance page-class :lisplet obj :url new-location)))) - (lisplet-realm obj))) + (lisplet-realm obj) + content-type)) pages))) (when welcome-pagep (setf (lisplet-welcome-page obj) new-location)))) +|# + +(defmethod lisplet-register-page-location ((obj lisplet) page-class location &optional welcome-pagep) + (let ((new-location (build-lisplet-location obj location))) + (lisplet-register-function-location obj + #'(lambda () + (with-output-to-string + (*standard-output*) + (page-render (make-instance page-class :lisplet obj :url new-location)))) + location + welcome-pagep))) -(defmethod lisplet-register-resource-location ((obj lisplet) resource-path location) +(defmethod lisplet-register-resource-location ((obj lisplet) resource-path location &optional content-type) (let ((pages (lisplet-pages obj)) (new-location (build-lisplet-location obj location))) - (set (lisplet-pages obj) + (setf (lisplet-pages obj) (sort-dispatchers (push-dispatcher (cons new-location - (create-folder-dispatcher-and-handler new-location resource-path)) + (if (directory-pathname-p resource-path) + (create-folder-dispatcher-and-handler new-location resource-path) + (create-static-file-dispatcher-and-handler new-location resource-path content-type))) pages))))) (defmethod lisplet-dispatch-request ((obj lisplet)) Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Fri Jan 25 06:30:05 2008 @@ -33,7 +33,7 @@ (export 'HUNCHENTOOT::SESSION-REALM 'HUNCHENTOOT) (defpackage :claw - (:use :cl :hunchentoot :alexandria :cl-ppcre) + (:use :cl :hunchentoot :alexandria :cl-ppcre :cl-fad) (:export :*html-4.01-strict* :*html-4.01-transitional* :*html-4.01-frameset* @@ -223,6 +223,7 @@ :lisplet-base-path :lisplet-dispatch-method :lisplet-register-page-location + :lisplet-register-function-location :lisplet-register-resource-location ;; clawserver :clawserver Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Fri Jan 25 06:30:05 2008 @@ -29,6 +29,8 @@ (in-package :claw-tests) +(defvar *this-file* (load-time-value + (or #.*compile-file-pathname* *load-pathname*))) (setf *clawserver-base-path* "/claw") @@ -81,17 +83,35 @@ (site-template> :title "Home test page" (p> :id "p" (ul> - (li> (a> :href "http://www.gentoo.org" :target "gentoo" - "gentoo")) + (li> (a> :href "images/matrix.jpg" + "show static file")) + (li> (a> :href "images/matrix2.jpg" + "show file by function")) (li> (a> :href "../test/realm.html" :target "clwo1" "realm on lisplet 'test'")) (li> (a> :href "../test2/realm.html" :target "clwo2" "realm on lisplet 'test2'")) (li> (a> :href "id-tests.html" "id generation test")) (li> (a> :href "form.html" ($> "form components test"))))))) - + +(defun test-image-file () + (make-pathname :directory (append (pathname-directory *this-file*) '("img")) :name "matrix" :type "jpg")) (lisplet-register-page-location *test-lisplet* 'index-page "index.html" t) +(lisplet-register-resource-location *test-lisplet* (test-image-file) "images/matrix.jpg" "image/jpeg") + +(lisplet-register-function-location *test-lisplet* + #'(lambda () + (let ((path (test-image-file))) + (progn + (setf (content-type) (mime-type path)) + (load-time-value + (with-open-file (in (test-image-file) :element-type 'flex:octet) + (let ((image-data (make-array (file-length in) + :element-type 'flex:octet))) + (read-sequence image-data in) + image-data)))))) + "images/matrix2.jpg" ) ;;;--------------------realm test page-------------------------------- (defclass realm-page (page) ())