;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: July 2003
;;;;
-;;;; $Id: project.lisp,v 1.1 2003/07/16 16:02:21 kevin Exp $
+;;;; $Id: project.lisp,v 1.2 2003/07/16 20:40:43 kevin Exp $
;;;;
;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;; *************************************************************************
(string= (request-raw-uri req)
(project-prefix (entity-project ent))))
+(defun redirect-entity (page ent)
+ (redirect-to-location
+ (format nil "~A~A" (project-prefix (entity-project ent)) page)))
+
(defun dispatch-request (req)
(let ((ent (find-entity-for-request req)))
(when ent
(let ((proj (entity-project ent)))
(if (is-index-request req ent)
(progn
- (redirect-to-location
- (format nil "~A~A"
- (project-prefix proj)
- (project-index proj)))
+ (redirect-entity (project-index proj) ent)
t)
(progn
(request-decompile-uri req ent)
(nth-value 0 (gethash (request-page req)
(project-hash-map (entity-project ent)))))
-(defun action-redirect (page req ent)
- (cmsg "redirect to ~A" page))
-
(defun handle-request (handler req ent)
(typecase handler
(null
(not (fboundp handler)))
(cmsg "handler given a symbol without a function ~S" handler)
(return-from handle-request nil))
- (let ((res (funcall handler req ent)))
- (typecase res
+ (let ((next-page (funcall handler req ent)))
+ (typecase next-page
(string
- (action-redirect res req ent))
+ (redirect-entity next-page ent))
(null
t)
(t
- (cmsg "handler should return nil or a string"))))
+ (cmsg "handler should return nil or a string, not ~S" next-page))))
t)
(string
(cmsg "string handler not supported: ~A" handler)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: July 2003
;;;;
-;;;; $Id: sessions.lisp,v 1.2 2003/07/16 16:40:35 kevin Exp $
+;;;; $Id: sessions.lisp,v 1.3 2003/07/16 20:40:43 kevin Exp $
;;;;
;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
;;;; *************************************************************************
"Find or make websession for key"
(let ((sessions (sessions (session-master (entity-project ent)))))
;; if sessions doesn't exist, then project is not session enabled
- (when session
+ (when sessions
(cond
((null key)
(make-websession req ent method))
collect s))
(defun all-sessions (&aux s)
- (dolist (p *active-projects* s)
- (let ((sm (session-master p))
- (sessions (when sm (sessions sm))))
- (when sessions
- (maphash
- (lambda (k v)
- (declare (ignore k))
- (push (cons v p) s))
- sessions)))))
+ (maphash
+ (lambda (name proj)
+ (declare (ignore name))
+ (let* ((sm (session-master proj))
+ (sessions (when sm (sessions sm))))
+ (when sessions
+ (maphash
+ (lambda (k v)
+ (declare (ignore k))
+ (push (cons v proj) s))
+ sessions))))
+ *active-projects*)
+ s)
(defmethod flush-expired (s)
(let ((sessions (sessions (session-master (cdr s)))))