Abstracting further into session

svn: r6382

collects/web-server/prototype-web-server/dispatch-servlets2.ss

@@ -21,29 +21,7 @@
   (define myprint #;printf (lambda _ (void)))
   
   (define top-cust (current-custodian))
-  
-  ;; Parameter Parsing
-  
-  ;; encodes a simple number:
-  (define (match-url-params x) (regexp-match #rx"([0-9]+)" x))
-  
-  ;; resume-session? url -> (union number #f)
-  ;; Determine if the url encodes a session-id and extract it
-  (define (resume-session? a-url)
-    (myprint "resume-session?: url-string = ~s~n" (url->string a-url))
-    (let ([k-params (filter match-url-params
-                            (apply append
-                                   (map path/param-param (url-path a-url))))])
-      (myprint "resume-session?: ~S~n" k-params)
-      (if (empty? k-params)
-          #f
-          (match (match-url-params (first k-params))
-            [(list _ n)
-             (myprint "resume-session?: Found ~a~n" n)
-             (string->number n)]
-            [_
-             #f]))))
-  
+    
   (define make-servlet-namespace
     (make-make-servlet-namespace
      #:to-be-copied-module-specs
@@ -84,7 +62,7 @@
                                   (responders-servlet-loading uri the-exn)
                                   (request-method req)))])
                 (cond
-                  [(resume-session? uri)
+                  [(extract-session uri)
                    => (lambda (session-id)
                         (resume-session session-id conn req))]
                   [else

collects/web-server/prototype-web-server/private/session.ss

@@ -1,5 +1,7 @@
 (module session mzscheme
   (require (lib "contract.ss")
+           (lib "list.ss")
+           (lib "plt-match.ss")
            (lib "url.ss" "net")
            (lib "request-structs.ss" "web-server")
            (lib "response.ss" "web-server"))
@@ -13,6 +15,7 @@
                     [namespace namespace?]
                     [servlet (request? . -> . response?)]
                     [url url?])]
+   [extract-session (url? . -> . (or/c number? false/c))]
    [lookup-session (number? . -> . (or/c session? false/c))]
    [new-session (custodian? namespace? url? . -> . session?)])
   
@@ -46,6 +49,21 @@
   ;; encode-session: url number -> url
   (define (encode-session a-url ses-id)
     (insert-param a-url (number->string ses-id)))
+    
+  ;; extract-session url -> (union number #f)
+  ;; Determine if the url encodes a session-id and extract it
+  (define (extract-session a-url)
+    (define (match-url-params x) (regexp-match #rx"([0-9]+)" x))
+    (let ([k-params (filter match-url-params
+                            (apply append
+                                   (map path/param-param (url-path a-url))))])
+      (if (empty? k-params)
+          #f
+          (match (match-url-params (first k-params))
+            [(list _ n)
+             (string->number n)]
+            [_
+             #f]))))
   
   ;; insert-param: url string -> string
   ;; add a path/param to the path in a url

collects/web-server/prototype-web-server/private/stuff-url.ss

@@ -12,7 +12,6 @@
   (provide/contract
    [stuff-url (serializable? url? . -> . url?)]
    [stuffed-url? (url? . -> . boolean?)]
-   [extend-url-query (url? symbol? string? . -> . url?)]
    [unstuff-url (url? . -> . serializable?)])
   
   ; XXX Abstract this
@@ -44,19 +43,7 @@
     (let* ([qry (url-query uri)]
            [l-code (find-binding 'c qry)])
       (and l-code
-           #t)))
-  
-  (define (extend-url-query uri key val)
-    (make-url
-     (url-scheme uri)
-     (url-user uri)
-     (url-host uri)
-     (url-port uri)
-     #t
-     (url-path uri)
-     (list* (cons key val)
-            (url-query uri))
-     (url-fragment uri)))
+           #t)))  
   
   ;; unstuff-url: url -> serial
   ;; decode from the url and reconstruct the serial

collects/web-server/prototype-web-server/private/utils.ss

@@ -7,6 +7,7 @@
   
   (provide/contract
    [find-binding (symbol? (listof (cons/c symbol? string?)) . -> . (or/c serializable? false/c))]
+   [extend-url-query (url? symbol? string? . -> . url?)]
    [read/string (string? . -> . serializable?)]
    [write/string (serializable? . -> . string?)]
    [url->servlet-path ((path? url?) . ->* . ((or/c path? false/c) (or/c (listof string?) false/c) (or/c (listof string?) false/c)))]
@@ -22,6 +23,18 @@
        (read/string (cdar qry))]
       [else (find-binding key (cdr qry))]))
   
+  (define (extend-url-query uri key val)
+    (make-url
+     (url-scheme uri)
+     (url-user uri)
+     (url-host uri)
+     (url-port uri)
+     #t
+     (url-path uri)
+     (list* (cons key val)
+            (url-query uri))
+     (url-fragment uri)))
+  
   (define (read/string str)
     (read (open-input-string str)))
   (define (write/string v)

collects/web-server/prototype-web-server/private/web.ss

@@ -6,7 +6,8 @@
            (rename "abort-resume.ss" send/suspend0 send/suspend)
            (all-except "abort-resume.ss" send/suspend)
            "session.ss"
-           "stuff-url.ss")
+           "stuff-url.ss"
+           "utils.ss")
   
   (provide 
    ;; Server Interface