Changeset 11985 in project

Timestamp:

09/23/08 22:58:18 (13 years ago)

Author:

sjamaan

Message:

Rearrange code a bit to make it more logical and easy to follow

File:

• release/4/spiffy/trunk/spiffy.scm (modified) (2 diffs)

release/4/spiffy/trunk/spiffy.scm

@@ -131 +131 @@
               (file-close fd)))))
 
+(define (extension->mime-type ext)
+  (alist-ref (or ext "") (mime-type-map) string-ci=? (default-mime-type)))
+
+(define (with-headers new-headers thunk)
+  (parameterize ((current-response
+                  (update-response
+                   (current-response)
+                   headers: (headers new-headers
+                                     (response-headers (current-response))))))
+    (thunk)))
+
+(define (process-directory path)
+  (let ((index-page (find (lambda (ip)
+                            (file-exists?
+                             (make-pathname (list (root-path) path) ip)))
+                          (index-files))))
+    (if index-page
+        (process-entry (make-pathname path index-page) '())
+        ((handle-directory) path))))
+
+;; If an URL is missing a trailing slash, instead of directly serving
+;; its index-file, redirect to the URL _with_ trailing slash.  This
+;; prevents problems with relative references since the directory
+;; would be seen as the file component in the path and get replaced.
+(define (redirect-directory-root path)
+  (let* ((newloc (make-pathname path "/"))
+         (url (uri-relative-to (uri-reference newloc)
+                               (request-uri (current-request)))))
+    (with-headers `((location ,url))
+      (lambda () (send-status 301 "Moved permanently")))))
+
+(define (process-entry current-path remaining-path)
+  (let ((path (make-pathname (root-path) current-path)))
+    (cond
+     ;; Check if there's a registered URI-handler first
+     ((directory? path)
+      (match remaining-path
+       (()    (redirect-directory-root current-path))
+       (("/") (process-directory current-path))
+       (else  (process-entry (make-pathname current-path (car remaining-path))
+                             (cdr remaining-path)))))
+     ((file-exists? path)
+      ((handle-file) path))
+     (else ((handle-not-found))))))
+
 ;; Determine the vhost to use. This tries to use the Host: header first
 ;; and it it's not there, falls back to try to determine the vhost
@@ -145 +190 @@
             #f
             (or (uri-host (request-uri (current-request))) "")))))
-
-(define (extension->mime-type ext)
-  (alist-ref (or ext "") (mime-type-map) string-ci=? (default-mime-type)))
-
-(define (with-headers new-headers thunk)
-  (parameterize ((current-response
-                  (update-response
-                   (current-response)
-                   headers: (headers new-headers
-                                     (response-headers (current-response))))))
-    (thunk)))
-
-(define (process-directory path)
-  (let ((index-page (find (lambda (ip)
-                            (file-exists?
-                             (make-pathname (list (root-path) path) ip)))
-                          (index-files))))
-    (if index-page
-        (process-entry (make-pathname path index-page) '())
-        ((handle-directory) path))))
-
-;; If an URL is missing a trailing slash, instead of directly serving
-;; its index-file, redirect to the URL _with_ trailing slash.  This
-;; prevents problems with relative references since the directory
-;; would be seen as the file component in the path and get replaced.
-(define (redirect-directory-root path)
-  (let* ((newloc (make-pathname path "/"))
-         (url (uri-relative-to (uri-reference newloc)
-                               (request-uri (current-request)))))
-    (with-headers `((location ,url))
-      (lambda () (send-status 301 "Moved permanently")))))
-
-(define (process-entry current-path remaining-path)
-  (let ((path (make-pathname (root-path) current-path)))
-    (cond
-     ;; Check if there's a registered URI-handler first
-     ((directory? path)
-      (match remaining-path
-       (()    (redirect-directory-root current-path))
-       (("/") (process-directory current-path))
-       (else  (process-entry (make-pathname current-path (car remaining-path))
-                             (cdr remaining-path)))))
-     ((file-exists? path)
-      ((handle-file) path))
-     (else ((handle-not-found))))))
 
 (define (handle-incoming-request in out)