added Clack.App.URLMap to map multiple apps in different paths.

clack-test.asd

@@ -36,6 +36,7 @@
        (:file "request")
        (:file "handler/hunchentoot")
        (:file "app/file")
+       (:file "app/urlmap")
        (:file "middleware/static")
        (:file "middleware/session")
        (:file "middleware/logger")))

clack.asd

@@ -74,7 +74,8 @@
                    (:module "app"
                     :depends-on ("clack")
                     :components
-                    ((:file "file")))
+                    ((:file "file")
+                     (:file "urlmap")))
                    (:file "logger")
                    (:module "middleware/logger"
                     :depends-on ("logger" "middleware")

src/core/app/urlmap.lisp

@@ -0,0 +1,93 @@
+#|
+  This file is a part of Clack package.
+  URL: http://github.com/fukamachi/clack
+  Copyright (c) 2011 Eitarow Fukamachi <e.arrows@gmail.com>
+
+  Clack is freely distributable under the LLGPL License.
+|#
+
+(clack.util:namespace clack.app.urlmap
+  (:use :cl
+        :clack
+        :anaphora
+        :metabang-bind)
+  (:import-from :cl-ppcre
+                :scan
+                :scan-to-strings
+                :regex-replace))
+
+(cl-annot:enable-annot-syntax)
+
+@export
+(defclass <clack-app-urlmap> (<component>)
+     ((%mapping :type list
+                :initform nil))
+  (:documentation "Class to map multiple apps in different paths."))
+
+@export
+(defmethod mount ((this <clack-app-urlmap>) location app)
+  "Regist an `app' to the `location'."
+  (bind ((#(host location)
+           (aif (nth-value
+                 1
+                 (scan-to-strings "^https?://(.*?)(/.*)" location))
+                it
+                `#(nil ,location))))
+    (unless (char= #\/ (aref location 0))
+      (error "Paths need to start with /"))
+    (push (list host location app)
+          (slot-value this '%mapping))))
+
+(defmethod call ((this <clack-app-urlmap>) env)
+  (let ((http-host
+         (regex-replace (format nil ":~D" (getf env :server-port))
+                        (getf env :http-host)
+                        "")))
+    (loop for (host location app) in (slot-value this '%mapping)
+          if (and (or (not host)
+                      (string= http-host host)
+                      (string= (getf env :server-name) host))
+                  (scan (format nil "^~A" location) (getf env :path-info)))
+            do (setf (getf env :path-info)
+                     (regex-replace location (getf env :path-info) "/"))
+               (setf (getf env :script-name)
+                     (concatenate 'string
+                                   (getf env :script-name)
+                                  location))
+               (return (call app env))
+          finally (return '(404 (:content-type "text/plain") ("Not Found"))))))
+
+@export
+(defmacro builder-urlmap (&rest apps)
+  "Useful syntax sugar to build applications."
+  (let ((urlmap (gensym "URLMAP")))
+    `(let ((,urlmap (make-instance '<clack-app-urlmap>)))
+       ,@(loop for app in apps
+               collect `(mount ,urlmap ,@app))
+       ,urlmap)))
+
+(doc:start)
+
+@doc:NAME "
+Clack.App.URLMap - Map multiple apps in different paths.
+"
+
+@doc:SYNOPSIS "
+    (defparameter *urlmap* (make-instance '<clack-app-urlmap>))
+    (mount *urlmap* \"/pc/\" #'app-for-pc)
+    (mount *urlmap* \"/api/\" #'app-for-api)
+    (call *urlmap* env)
+    
+    ;; Useful synonym.
+    (builder-urlmap
+      (\"/pc/\" #'app-for-pc)
+      (\"/api/\" #'app-for-api))
+"
+
+@doc:AUTHOR "
+* Eitarow Fukamachi (e.arrows@gmail.com)
+"
+
+@doc:SEE "
+* Clack.Builder
+"

t/core/app/urlmap.lisp

@@ -0,0 +1,57 @@
+(clack.util:namespace clack-test.app.urlmap
+  (:use :cl
+        :clack
+        :clack.app.urlmap
+        :cl-test-more))
+
+(plan 4)
+
+(defparameter *urlmap* (make-instance '<clack-app-urlmap>))
+
+(mount *urlmap* "/pc/" (lambda (env) (list 200 nil env)))
+(mount *urlmap* "/api/" (lambda (env) (list 200 nil env)))
+
+(is (call
+     *urlmap*
+     '(:path-info "/pc/hoge"
+       :script-name ""
+       :http-host "localhost:4242"
+       :server-port 4242))
+    '(200
+      nil
+      (:path-info "/hoge"
+       :script-name "/pc/"
+       :http-host "localhost:4242"
+       :server-port 4242))
+    "mount")
+
+(is (call
+     *urlmap*
+     '(:path-info "/api/hoge"
+       :script-name ""
+       :http-host "localhost:4242"
+       :server-port 4242))
+    '(200
+      nil
+      (:path-info "/hoge"
+       :script-name "/api/"
+       :http-host "localhost:4242"
+       :server-port 4242))
+    "mount 2")
+
+(is-expand (builder-urlmap
+            ("/pc/" app-for-pc)
+            ("/api/" app-for-api))
+           (let (($urlmap (make-instance '<clack-app-urlmap>)))
+             (mount $urlmap "/pc/" app-for-pc)
+             (mount $urlmap "/api/" app-for-api)
+             $urlmap)
+           "builder-urlmap (expansion)")
+
+(is-type (builder-urlmap
+          ("/pc/" (lambda (env) (list 200 nil env)))
+          ("/api/" (lambda (env) (list 200 nil env))))
+         '<clack-app-urlmap>
+         "builder-urlmap")
+
+(finalize)