suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Abstracting parameters

Browse Source 
svn: r6384
This commit is contained in:
Jay McCarthy 2007-05-29 18:11:01 +00:00
parent f8dd838409
commit d8d99e619a
1 changed files with 21 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/web-server/prototype-web-server/private/session.ss
View File

@ -48,36 +48,42 @@
;; encode-session : url number -> url ;; encode-session : url number -> url
(define (encode-session a-url ses-id) (define (encode-session a-url ses-id)
(insert-param a-url (number->string ses-id))) (insert-param a-url 's (number->string ses-id)))
;; extract-session url -> (union number #f) ;; extract-session : url -> (union number #f)
;; Determine if the url encodes a session-id and extract it ;; Determine if the url encodes a session-id and extract it
(define (extract-session a-url) (define (extract-session a-url)
(define (match-url-params x) (regexp-match #rx"([0-9]+)" x)) (define id (extract-param a-url "s"))
(with-handlers ([exn? (lambda _ #f)])
(string->number id)))
;; extract-param : url string -> string
(define (extract-param url key)
(define (match-url-params x) (regexp-match (format "^~a=(.+)$" key) x))
(let ([k-params (filter match-url-params (let ([k-params (filter match-url-params
(apply append (apply append
(map path/param-param (url-path a-url))))]) (map path/param-param (url-path url))))])
(if (empty? k-params) (if (empty? k-params)
#f #f
(match (match-url-params (first k-params)) (match (match-url-params (first k-params))
[(list _ n) [(list _ val)
(string->number n)] val]
[_ [_
#f])))) #f]))))
;; insert-param: url string -> string ;; insert-param : url string string -> url
;; add a path/param to the path in a url ;; add a path/param to the path in a url
;; (assumes that there is only one path/param) ;; (assumes that there is only one path/param)
(define (insert-param in-url new-param-str) (define (insert-param in-url key new-param-str)
(replace-path (replace-path
(lambda (old-path) (lambda (old-path)
(if (null? old-path) (if (null? old-path)
(list (make-path/param "" (list new-param-str))) (list (make-path/param "" (list (format "~a=~a" key new-param-str))))
(let* ([car-old-path (car old-path)]) (let* ([car-old-path (car old-path)])
(cons (make-path/param (if (path/param? car-old-path) (cons (make-path/param (if (path/param? car-old-path)
(path/param-path car-old-path) (path/param-path car-old-path)
car-old-path) car-old-path)
(list new-param-str)) (list (format "~a=~a" key new-param-str)))
(cdr old-path))))) (cdr old-path)))))
in-url)) in-url))