[bknr-cvs] r2419 - in branches/trunk-reorg: bknr/web/src bknr/web/src/images bknr/web/src/web projects/quickhoney/src
hhubner at common-lisp.net
hhubner at common-lisp.net
Wed Jan 30 08:46:12 UTC 2008
Author: hhubner
Date: Wed Jan 30 03:46:10 2008
New Revision: 2419
Modified:
branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp
branches/trunk-reorg/bknr/web/src/packages.lisp
branches/trunk-reorg/bknr/web/src/web/handlers.lisp
branches/trunk-reorg/projects/quickhoney/src/init.lisp
branches/trunk-reorg/projects/quickhoney/src/webserver.lisp
Log:
Move reference of 'modules' into website handlers definition instead of
putting the module handlers at the end of the handler list.
Make imageproc work, yay!
Modified: branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp Wed Jan 30 03:46:10 2008
@@ -34,9 +34,12 @@
(when (and (true-color-p working-image)
(not (true-color-p input-image)))
(true-color-to-palette :dither t :image working-image :colors-wanted 256))
- (write-image-to-stream *html-stream* (image-type-keyword image) :image working-image)
+ (let ((stream (send-headers)))
+ (setf (flex:flexi-stream-element-type stream) 'flex:octet)
+ (write-image-to-stream stream (image-type-keyword image) :image working-image))
(unless (eq working-image input-image)
(destroy-image working-image)))))
+
#+(or)
(unless (member type '(:jpg :jpeg))
(when (true-color-p input-image)
@@ -167,8 +170,9 @@
(defmethod handle-object ((page-handler imageproc-handler) image)
(format t "if-modfied-since not implemented for hunchentoot~%")
- (with-http-body ()
- (imageproc image (cdr (decoded-handler-path page-handler))))
+ (with-http-response (:content-type (image-content-type (image-type-keyword image)))
+ (with-http-body ()
+ (imageproc image (cdr (decoded-handler-path page-handler)))))
#+(or)
(with-http-response (:content-type (image-content-type (image-type-keyword image)))
(let ((ims (header-in :if-modified-since))
Modified: branches/trunk-reorg/bknr/web/src/packages.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/packages.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/packages.lisp Wed Jan 30 03:46:10 2008
@@ -301,6 +301,7 @@
#:handle-form
#:object-handler-object-class
#:object-handler-get-object
+ #:require-user-flag
#:bknr-authorizer
#:find-user-from-request-parameters
Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Wed Jan 30 03:46:10 2008
@@ -23,8 +23,6 @@
:accessor website-authorizer)
(handler-definitions :initarg :handler-definitions
:accessor website-handler-definitions)
- (modules :initarg :modules
- :accessor website-modules)
(handlers :initform nil :accessor website-handlers)
(menu :initarg :menu)
(menudef-xml-file :initarg :menudef-xml-file
@@ -58,7 +56,6 @@
(:default-initargs :url nil
:vhosts :wild
:authorizer (make-instance 'bknr-authorizer)
- :modules nil
:menu nil
:navigation nil
:admin-navigation nil
@@ -124,19 +121,26 @@
(setf (choice-submenu (first choices)) (process-choices-xml (cddr choice-xml)))))
(reverse choices)))
+(defgeneric process-handler-definition (website definition)
+ (:documentation "Process a handler definition entry DEFINITION which
+may either be a LIST of (PATH HANDLER-CLASS &optional INITARGS) or a
+symbol, denoting a module to load at this point in the (linear)
+handler definition. Every method returns a list of handler instances.")
+ (:method (website (definition list))
+ (list (apply #'make-instance (handler-definition-class definition)
+ :name (handler-definition-name definition)
+ :site website
+ (handler-definition-initargs definition))))
+ (:method (website (module-name symbol))
+ (mapcan (curry #'process-handler-definition website)
+ (or (gethash (symbol-name module-name) *website-modules*)
+ (error "bknr module ~A not known" module-name)))))
+
(defmethod publish-site ((website website))
(setf (website-handlers website)
- (mapcar #'(lambda (handler-definition)
- (apply #'make-instance (handler-definition-class
- handler-definition)
- :name (handler-definition-name handler-definition)
- :site website
- (handler-definition-initargs handler-definition)))
- (apply #'append
- (website-handler-definitions website)
- (mapcar #'(lambda (module-name) (or (gethash (symbol-name module-name) *website-modules*)
- (error "bknr module ~A not known" module-name)))
- (website-modules website)))))
+ (mapcan (curry #'process-handler-definition website)
+ (website-handler-definitions website)))
+ ;; XXX implicitly creating a template handler seems wrong:
(when (website-template-base-directory website)
(setf (slot-value website 'template-handler) (make-instance 'template-handler
:name "/"
@@ -145,9 +149,7 @@
:command-packages (website-template-command-packages website)))
(push (website-template-handler website)
(website-handlers website)))
- (mapc #'(lambda (handler)
- (publish-handler website handler))
- (website-handlers website))
+ (mapc (curry #'publish-handler website) (website-handlers website))
(pushnew 'bknr-dispatch *dispatch-table*))
(defmethod website-session-info ((website website))
@@ -253,7 +255,7 @@
(defun bknr-dispatch (request)
(declare (ignore request))
- (when-let ((handler (find-if #'handler-matches *handlers*)))
+ (when-let ((handler (find-if #'handler-matches (website-handlers *website*))))
(curry #'invoke-handler handler)))
(defmethod publish-handler ((website website) (handler page-handler))
Modified: branches/trunk-reorg/projects/quickhoney/src/init.lisp
==============================================================================
--- branches/trunk-reorg/projects/quickhoney/src/init.lisp (original)
+++ branches/trunk-reorg/projects/quickhoney/src/init.lisp Wed Jan 30 03:46:10 2008
@@ -15,4 +15,5 @@
(bknr.cron:make-cron-job "snapshot" 'snapshot-store 0 5 :every :every))
#+cmu
(actor-start (make-instance 'cron-actor))
- (publish-quickhoney))
+ (publish-quickhoney)
+ (hunchentoot:start-server :port *webserver-port*))
Modified: branches/trunk-reorg/projects/quickhoney/src/webserver.lisp
==============================================================================
--- branches/trunk-reorg/projects/quickhoney/src/webserver.lisp (original)
+++ branches/trunk-reorg/projects/quickhoney/src/webserver.lisp Wed Jan 30 03:46:10 2008
@@ -6,7 +6,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun publish-quickhoney (&key (port *webserver-port*))
+(defun publish-quickhoney ()
(setf bknr.web::*upload-file-size-limit* (* 30 1024 1024))
(unpublish)
@@ -25,16 +25,17 @@
("/rss" rss-handler)
("/" redirect-handler
:to "/frontpage")
- ("/" template-handler
- :destination ,(namestring (merge-pathnames "templates/" *website-directory*))
- :command-packages ((:quickhoney . :quickhoney.tags)
- (:bknr . :bknr.web)))
+ user
+ images
("/static" directory-handler
:destination ,(merge-pathnames #p"static/" *website-directory*))
("/favicon.ico" file-handler
:destination ,(merge-pathnames #p"static/favicon.ico" *website-directory*)
- :content-type "application/x-icon"))
- :modules '(user images)
+ :content-type "application/x-icon")
+ ("/" template-handler
+ :destination ,(namestring (merge-pathnames "templates/" *website-directory*))
+ :command-packages ((:quickhoney . :quickhoney.tags)
+ (:bknr . :bknr.web))))
:admin-navigation '(("user" . "/user/")
("images" . "/edit-images")
("import" . "/import")
@@ -43,6 +44,4 @@
:site-logo-url "/image/quickhoney/color,000000,33ff00"
:login-logo-url "/image/quickhoney/color,000000,33ff00/double,3"
:style-sheet-urls '("/static/styles.css")
- :javascript-urls '("/static/javascript.js"))
-
- (hunchentoot:start-server :port port))
+ :javascript-urls '("/static/javascript.js")))
More information about the Bknr-cvs
mailing list