Cleaning up interface and standardizing functions
svn: r12330
This commit is contained in:
parent
dd0bc805fb
commit
61b44707cd
|
@ -1,7 +1,11 @@
|
|||
#lang scheme/base
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
|
||||
net/url
|
||||
web-server/servlet/web)
|
||||
(require/expose web-server/servlet/web
|
||||
(embed-ids))
|
||||
|
||||
(provide web-tests)
|
||||
|
||||
(define url0 (string->url "http://test.com/servlets/example.ss"))
|
||||
|
|
|
@ -502,12 +502,6 @@ functions of interest for the servlet developer.}
|
|||
returns the instance id, continuation id, and nonce.
|
||||
}
|
||||
|
||||
@defproc[(embed-ids [ids (list/c number? number? number?)]
|
||||
[u url?])
|
||||
string?]{
|
||||
Creates a @scheme[continuation-url?].
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "helpers.ss"]{Helpers}
|
||||
@(require (for-label web-server/servlet/helpers))
|
||||
|
|
|
@ -1,8 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require net/url
|
||||
mzlib/list
|
||||
mzlib/plt-match
|
||||
scheme/contract)
|
||||
#lang scheme
|
||||
(require net/url)
|
||||
(require "../managers/manager.ss"
|
||||
"../private/util.ss"
|
||||
"../private/servlet.ss"
|
||||
|
@ -14,58 +11,30 @@
|
|||
|
||||
(provide servlet-prompt)
|
||||
|
||||
;; ************************************************************
|
||||
;; HELPERS
|
||||
(provide/contract
|
||||
[continuation-url? (url? . -> . (or/c false/c (list/c number? number? number?)))]
|
||||
[embed-ids ((list/c number? number? number?) url? . -> . string?)])
|
||||
|
||||
;; ********************************************************************************
|
||||
;; Parameter Embedding
|
||||
(require web-server/private/url-param)
|
||||
|
||||
;; embed-ids: (list number number number) url -> string
|
||||
(define embed-ids
|
||||
(match-lambda*
|
||||
[(list (list inst-id k-id salt) in-url)
|
||||
(define (embed-ids v u)
|
||||
(url->string
|
||||
(insert-param
|
||||
in-url
|
||||
(format "~a*~a*~a" inst-id k-id salt))]))
|
||||
u "k" (write/string v))))
|
||||
|
||||
;; continuation-url?: url -> (or/c (list number number number) #f)
|
||||
;; determine if this url encodes a continuation and extract the instance id and
|
||||
;; continuation id.
|
||||
(define (continuation-url? a-url)
|
||||
(define (match-url-params x) (regexp-match #rx"([^\\*]*)\\*([^\\*]*)\\*([^\\*]*)" 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 s instance k-id salt)
|
||||
(let ([instance/n (string->number instance)]
|
||||
[k-id/n (string->number k-id)]
|
||||
[salt/n (string->number salt)])
|
||||
(if (and (number? instance/n)
|
||||
(number? k-id/n)
|
||||
(number? salt/n))
|
||||
(list instance/n
|
||||
k-id/n
|
||||
salt/n)
|
||||
#f))]))))
|
||||
(cond
|
||||
[(extract-param a-url "k")
|
||||
=> read/string]
|
||||
[else
|
||||
#f]))
|
||||
|
||||
;; insert-param: url string -> string
|
||||
;; add a path/param to the path in a url
|
||||
;; (assumes that there is only one path/param)
|
||||
(define (insert-param in-url new-param-str)
|
||||
(url->string
|
||||
(url-replace-path
|
||||
(lambda (old-path)
|
||||
(if (empty? old-path)
|
||||
(list (make-path/param "" (list new-param-str)))
|
||||
(list* (make-path/param (path/param-path (first old-path))
|
||||
(list new-param-str))
|
||||
(rest old-path))))
|
||||
in-url)))
|
||||
(provide/contract
|
||||
[continuation-url? (url? . -> . (or/c false/c (list/c number? number? number?)))])
|
||||
|
||||
;; ********************************************************************************
|
||||
|
||||
(provide/contract
|
||||
[current-url-transform (parameter/c url-transform/c)]
|
||||
|
|
Loading…
Reference in New Issue
Block a user