Removing some old functions
svn: r12395
This commit is contained in:
Jay McCarthy
parent
35cb453ea9
commit
9c174affa7
|
|
@ -81,11 +81,6 @@
|
|||
(first ((sxpath "//form/@action/text()") (call d k (list (make-binding:form #"answer" #"0"))))))
|
||||
url0
|
||||
(build-list 7 (lambda (i) i)))))
|
||||
(test-equal? "cut.ss - current-url-transform"
|
||||
(let* ([d (mkd (build-path example-servlets "cut.ss"))]
|
||||
[k0 (first ((sxpath "//a/@href/text()") (call d url0 empty)))])
|
||||
k0)
|
||||
"#")
|
||||
(test-equal? "clear.ss - current-servlet-continuation-expiration-handler, clear-continuation-table!, send/finish, send/forward"
|
||||
(let* ([d (mkd (build-path example-servlets "clear.ss"))]
|
||||
[k0 (first ((sxpath "//a/@href/text()") (call d url0 empty)))]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
"bindings-test.ss"
|
||||
"servlet-url-test.ss"
|
||||
"basic-auth-test.ss"
|
||||
"helpers-test.ss"
|
||||
"web-test.ss")
|
||||
|
|
@ -11,7 +10,6 @@
|
|||
(test-suite
|
||||
"Servlet (Internal)"
|
||||
bindings-tests
|
||||
servlet-url-tests
|
||||
basic-auth-tests
|
||||
helpers-tests
|
||||
web-tests))
|
||||
|
|
|
|||
|
|
@ -1,29 +0,0 @@
|
|||
#lang scheme/base
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
mzlib/list
|
||||
net/url
|
||||
web-server/servlet/servlet-url
|
||||
web-server/private/request-structs)
|
||||
(provide servlet-url-tests)
|
||||
|
||||
(define servlet-url-tests
|
||||
(test-suite
|
||||
"Servlet URLs"
|
||||
|
||||
(test-case
|
||||
"Basic"
|
||||
(check-equal? (servlet-url->url-string/no-continuation
|
||||
(request->servlet-url
|
||||
(make-request 'get (string->url "http://localhost/servlets;1*1*65539753/examples/add.ss")
|
||||
empty empty #f
|
||||
"host" 80 "client")))
|
||||
"http://localhost/servlets/examples/add.ss"))
|
||||
|
||||
(test-case
|
||||
"Param"
|
||||
(check-equal? (servlet-url->url-string/no-continuation
|
||||
(request->servlet-url
|
||||
(make-request 'get (string->url "http://localhost/servlets;1*1*65539753/examples/add.ss;foo")
|
||||
empty empty #f
|
||||
"host" 80 "client")))
|
||||
"http://localhost/servlets/examples/add.ss;foo"))))
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
#lang scheme/base
|
||||
(require web-server/servlet)
|
||||
(provide (all-defined-out))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(parameterize ([current-url-transform
|
||||
(lambda (k-url) "#")])
|
||||
(send/suspend
|
||||
(lambda (k-url)
|
||||
`(html (head (title "Hello"))
|
||||
(body (a ([href ,k-url])
|
||||
"Link")))))))
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
#lang scheme/base
|
||||
(require net/url
|
||||
mzlib/plt-match)
|
||||
(provide xexpr+extras->xexpr)
|
||||
|
||||
(define xexpr+extras->xexpr
|
||||
(match-lambda
|
||||
[(list xe ...)
|
||||
(map xexpr+extras->xexpr xe)]
|
||||
[(and url (? url?))
|
||||
(url->string url)]
|
||||
[x
|
||||
x]))
|
||||
|
|
@ -107,12 +107,6 @@ Example: @schemeblock[(lambda (k-url)
|
|||
"Click Me to Invoke the Continuation!"))))]
|
||||
}
|
||||
|
||||
@defthing[url-transform? contract?]{
|
||||
Equivalent to @scheme[(k-url? . -> . k-url?)].
|
||||
|
||||
Example: @scheme[(lambda (k-url) (regexp-replace "^/" k-url "/servlets/"))]
|
||||
}
|
||||
|
||||
@defthing[expiration-handler/c contract?]{
|
||||
Equivalent to @scheme[(or/c false/c (request? . -> . response?))].
|
||||
|
||||
|
|
@ -496,13 +490,6 @@ functions of interest for the servlet developer.}
|
|||
@warning{This is deprecated and will be removed in a future release.}
|
||||
}
|
||||
|
||||
@defthing[current-url-transform (parameter/c url-transform?)]{
|
||||
Holds a @scheme[url-transform?] function that is called by
|
||||
@scheme[send/suspend] to transform the URLs it generates.
|
||||
|
||||
@warning{This is deprecated and will be removed in a future release.}
|
||||
}
|
||||
|
||||
@defproc[(continuation-url? [u url?])
|
||||
(or/c false/c (list/c number? number? number?))]{
|
||||
Checks if @scheme[u] is a URL that refers to a continuation, if so
|
||||
|
|
@ -555,24 +542,6 @@ functions of interest for the servlet developer.}
|
|||
]
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "servlet-url.ss"]{Servlet URLs}
|
||||
@(require (for-label web-server/servlet/servlet-url))
|
||||
|
||||
@defmodule[web-server/servlet/servlet-url]
|
||||
|
||||
@filepath{servlet/servlet-url.ss} provides functions that might be useful to you.
|
||||
They may eventually provided by another module.
|
||||
|
||||
@defproc[(request->servlet-url (req request?))
|
||||
servlet-url?]{Generates a value to be passed to the next function.}
|
||||
|
||||
@defproc[(servlet-url->url-string/no-continuation [su servlet-url?])
|
||||
string?]{
|
||||
Returns a URL string without the continuation information in the URL
|
||||
that went into @scheme[su].
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "basic-auth.ss"]{Basic Authentication}
|
||||
@(require (for-label web-server/servlet/basic-auth))
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
"servlet/web-cells.ss"
|
||||
"servlet/bindings.ss"
|
||||
"servlet/basic-auth.ss"
|
||||
"servlet/servlet-url.ss"
|
||||
"servlet/web.ss"
|
||||
"servlet/servlet-structs.ss"
|
||||
"private/response-structs.ss"
|
||||
|
|
@ -11,7 +10,6 @@
|
|||
(provide (all-from-out "servlet/web.ss")
|
||||
(all-from-out "servlet/web-cells.ss")
|
||||
(all-from-out "servlet/helpers.ss")
|
||||
(all-from-out "servlet/servlet-url.ss")
|
||||
(all-from-out "servlet/bindings.ss")
|
||||
(all-from-out "servlet/basic-auth.ss")
|
||||
(all-from-out "servlet/servlet-structs.ss")
|
||||
|
|
|
|||
|
|
@ -9,9 +9,6 @@
|
|||
(define response-generator/c
|
||||
(k-url? . -> . response?))
|
||||
|
||||
(define url-transform/c
|
||||
(k-url? . -> . k-url?))
|
||||
|
||||
(define expiration-handler/c
|
||||
(or/c false/c
|
||||
(request? . -> . response?)))
|
||||
|
|
@ -22,6 +19,5 @@
|
|||
(provide/contract
|
||||
[response-generator/c contract?]
|
||||
[k-url? (any/c . -> . boolean?)]
|
||||
[url-transform/c contract?]
|
||||
[expiration-handler/c contract?]
|
||||
[embed/url/c contract?])
|
||||
|
|
|
|||
|
|
@ -1,27 +0,0 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/list
|
||||
mzlib/contract
|
||||
net/url)
|
||||
(require "../private/request-structs.ss"
|
||||
"../private/util.ss")
|
||||
|
||||
(define-struct servlet-url (url))
|
||||
(define (servlet-url->url-string/no-continuation su)
|
||||
(define in-url (servlet-url-url su))
|
||||
(define first? (box #t))
|
||||
(url->string
|
||||
(url-replace-path
|
||||
(lambda (ps)
|
||||
(map (lambda (p/p)
|
||||
(if (unbox first?)
|
||||
(begin0 (make-path/param (path/param-path p/p) empty)
|
||||
(set-box! first? #f))
|
||||
p/p))
|
||||
ps))
|
||||
in-url)))
|
||||
(define (request->servlet-url req)
|
||||
(make-servlet-url (request-uri req)))
|
||||
|
||||
(provide/contract
|
||||
[servlet-url->url-string/no-continuation (servlet-url? . -> . string?)]
|
||||
[request->servlet-url (request? . -> . servlet-url?)])
|
||||
|
|
@ -37,7 +37,6 @@
|
|||
;; ********************************************************************************
|
||||
|
||||
(provide/contract
|
||||
[current-url-transform (parameter/c url-transform/c)]
|
||||
[current-servlet-continuation-expiration-handler (parameter/c expiration-handler/c)]
|
||||
[redirect/get (-> request?)]
|
||||
[redirect/get/forget (-> request?)]
|
||||
|
|
@ -52,11 +51,6 @@
|
|||
;; ************************************************************
|
||||
;; EXPORTS
|
||||
|
||||
;; current-url-transform : string? -> string?
|
||||
(define (default-url-transformer x) x)
|
||||
(define current-url-transform
|
||||
(make-parameter default-url-transformer))
|
||||
|
||||
;; current-servlet-continuation-expiration-handler : request -> response
|
||||
(define current-servlet-continuation-expiration-handler
|
||||
(make-parameter #f))
|
||||
|
|
@ -95,10 +89,9 @@
|
|||
instance-id
|
||||
(make-custodian-box (current-custodian) k)
|
||||
expiration-handler))
|
||||
(define k-url ((current-url-transform)
|
||||
(embed-ids
|
||||
(list* instance-id k-embedding)
|
||||
(request-uri (execution-context-request ctxt)))))
|
||||
(define k-url (embed-ids
|
||||
(list* instance-id k-embedding)
|
||||
(request-uri (execution-context-request ctxt))))
|
||||
(send/back (response-generator k-url)))
|
||||
servlet-prompt)
|
||||
(restore-web-cell-set! wcs)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user