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