[claw-cvs] r4 - in trunk/main/claw-core: . src tests
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Fri Jan 25 11:30:07 UTC 2008
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) ())
More information about the Claw-cvs
mailing list