Hi there,
I've managed to set up two acceptors which use different dispatch tables and write to different message log files by using packages and passing modified copies of LOG-MESSAGE-TO-FILE and LIST-REQUEST-DISPATCHER as keyword args when instantiating each acceptor (within each package).
It works but there is a lot of code duplication going on so I decided to try and creating a third package (maytal) which does essentially the same thing in an abstracted way by subclassing TBNL:ACCEPTOR.
I should point out that If I'm barking up the wrong tree entirely, it's because I'm new to CLOS (and relatively new to OOP in general).
In short, I'm trying to create a package (maytal) which I can use in other packages like so:
;; set up and enter development environment package (in-package :cl-user) (defpackage "DEV-ENV" (:use :cl)) (in-package :dev-env)
;; dev-env::*dispatch-table* (defvar *dispatch-table* '())
;; instantiate dev-env::*acceptor* (defvar *acceptor* (make-instance 'maytal::acceptor :port 49154 :msg-log-file "./messages/dev.log" :dispatch-table *dispatch-table*))
(tbnl:start *acceptor*) (msg 'info "DEV-ENV::*ACCEPTOR* started on port 49154")
Here's my first stab at creating maytal:
(in-package :cl-user) (defpackage "MAYTAL" (:use :cl)) (in-package :maytal)
(defclass acceptor (tbnl:acceptor) ((msg-log-file :initarg :msg-log-file) (dispatch-table :initarg :dispatch-table)))
(defmethod initialize-instance :after ((a acceptor) &key) ;; prepare local environment for closures (let ((mlf (slot-value a 'msg-log-file)) (dt (slot-value a 'dispatch-table)))
;; handy (i.e., short-name) message log function based on tbnl:log-message-to-file (defun msg (log-level format-string &rest format-arguments) (tbnl::with-log-file (stream mlf (tbnl::make-lock (symbol-name (gensym)))) (format stream "[~A~@[ [~A]~]] ~?~%" (tbnl::iso-time) log-level format-string format-arguments)))
(setf (slot-value a 'tbnl::message-logger) 'msg)
;; annonymous request dispatcher function based on tbnl:list-request-dispatcher but ;; which uses a locally defined dispatch table variable (setf (slot-value a 'tbnl::request-dispatcher) (lambda (request) (loop for dispatcher in dt for action = (funcall dispatcher request) when action return (funcall action) finally (setf (tbnl:return-code tbnl:*reply*) tbnl:+http-not-found+))) ))
Needless to say it doesn't work. The function 'msg' is defined in the maytal package rather than in the package which is current when an instance of maytal::acceptor is created (thus defeating the whole purpose of my efforts), and although the request dispatcher functions in different packages appear to use different dispatch tables, they don't actually work!
;;; (in-package :dev-env) (msg 'info "Acceptor ITI-DEV::*ACCEPTOR* started on port 49154") ;;; => Undefined function MSG called with arguments [...] (tbnl::acceptor-message-logger *acceptor*) ;;; => MAYTAL::MSG
(tbnl::acceptor-request-dispatcher *acceptor*) ;;; => #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL (INITIALIZE-INSTANCE :AFTER (MAYTAL::ACCEPTOR))) #x91D16C6> Any and all help very much appreciated.
Regards,
Seb
On Wed, Oct 14, 2009 at 2:47 PM, Sebastian Tennant sebyte@smolny.plus.com wrote:
I've managed to set up two acceptors which use different dispatch tables and write to different message log files by using packages [...]
From taking a quick glance at what you wrote here my suspicion is that
you have the wrong concept of Lisp packages. I'd suggest that you take a look at this
and then for example read the chapter about packages in Peter Seibel's book.
HTH, Edi.
Hi Edi,
Thanks for your reply.
Quoth Edi Weitz edi@agharta.de:
From taking a quick glance at what you wrote here my suspicion is that you have the wrong concept of Lisp packages. I'd suggest that you take a look at this
and then for example read the chapter about packages in Peter Seibel's book.
I've read this chapter and I've also read Erann Gat's 'Complete Idiot's Guide to Common Lisp Packages'. Gat goes into considerably greater depth than Seibel and I think it's fair to say that I do understand packages; namespaces respected by the Lisp reader, nothing more.
Everything I'm trying to do is in attempt to make it quick and easy to create development and production environments served by hunchentoot in a single Lisp image.
I was trying to subclass ACCEPTOR so that I can create them like so:
(defvar *dispatch-table#1* '()) (make-instance 'my-subclassed-acceptor :port 1234 :msg-log-file "~/htoot-message-file#1.log" :dispatch-table *dispatch-table#1*)
Making an instance of my-subclassed-acceptor should also define a function 'msg' which writes to the log file specified.
I was then attempting to put the code that implements this subclass in its own package so that it can easily be use'd in other packages.
You have designed hunchentoot with the ability to create multiple acceptors, each listening on a different port. I am simply trying to extend that spearation so that each acceptor can be configured to use its own dispatch table and write to its own message log file.
Seb
Another approach is to add an dispachtable slot to an customized acceptor class (as it was before Hunchentoot version 1.0):
(in-package :hunchentoot)
(defun pre1-list-request-dispatcher (request) (loop for dispatcher in (acceptor-dispatch-table *acceptor*) for action = (funcall dispatcher request) when action return (funcall action) finally (setf (return-code *reply*) +http-not-found+)))
(defclass pre1-acceptor (acceptor) ((pre1-dispatch-table :initarg :dispatch-table :accessor acceptor-dispatch-table)) (:default-initargs :request-dispatcher #'pre1-list-request-dispatcher :dispatch-table nil))
;; (setf *myserver1* (make-instance 'pre1-acceptor :port 42001)) ;; (setf (acceptor-dispatch-table *myserver1*) (list (create-prefix- dispatcher "/mypage1.html" #'mypage1)))
Quoth "R.Stoye" stoye@stoye.com:
Another approach is to add an dispachtable slot to an customized acceptor class (as it was before Hunchentoot version 1.0):
Thanks for your suggestion. Noted and understood. (In fact I had already done something very similar).
My claim (in an earlier thread) that I understood Common Lisp packages was true, but I realise now that I didn't quite understand how they're used in real world applications.
For some reason, I thought it would be better not to 'pollute' the hunchentoot namespace with my own subclasses e.t.c., hence my attempt to subclass the hunchentoot acceptor class from within a separate namespace/package; maytal. I realise now that this is an almost unworkable and entirely unnecessary practice.
Seb
Sebastian Tennant wrote:
For some reason, I thought it would be better not to 'pollute' the hunchentoot namespace with my own subclasses e.t.c., hence my attempt to subclass the hunchentoot acceptor class from within a separate namespace/package; maytal. I realise now that this is an almost unworkable and entirely unnecessary practice.
Well, you shouldn't place your own symbols (~subclasses) into the Hunchentoot package indeed.
Leslie