Simplifying

svn: r6621
This commit is contained in:
Jay McCarthy 2007-06-13 01:52:53 +00:00
parent 1f0c06c0e8
commit e433ec1144
5 changed files with 20 additions and 25 deletions

View File

@ -11,10 +11,9 @@
"../servlet/web-cells.ss" "../servlet/web-cells.ss"
"../servlet/web.ss" "../servlet/web.ss"
"../configuration/responders.ss" "../configuration/responders.ss"
"../configuration/namespace.ss"
"../managers/manager.ss" "../managers/manager.ss"
"../managers/timeouts.ss" "../managers/timeouts.ss"
"../managers/lru.ss"
"../managers/none.ss"
"../private/servlet.ss" "../private/servlet.ss"
"../private/cache-table.ss" "../private/cache-table.ss"
"../private/util.ss") "../private/util.ss")
@ -23,9 +22,11 @@
(provide make) (provide make)
(define interface-version 'v1) (define interface-version 'v1)
(define/kw (make config:instances config:scripts config:make-servlet-namespace (define/kw (make config:scripts
#:key #:key
url->path url->path
[make-servlet-namespace
(make-make-servlet-namespace)]
[responders-servlet-loading [responders-servlet-loading
servlet-loading-responder] servlet-loading-responder]
[responders-servlet [responders-servlet
@ -183,7 +184,7 @@
;; load-servlet/path path -> servlet ;; load-servlet/path path -> servlet
(define (load-servlet/path a-path) (define (load-servlet/path a-path)
(parameterize ([current-namespace (config:make-servlet-namespace (parameterize ([current-namespace (make-servlet-namespace
#:additional-specs #:additional-specs
'((lib "servlet.ss" "web-server") '((lib "servlet.ss" "web-server")
(lib "servlet.ss" "web-server" "private") (lib "servlet.ss" "web-server" "private")
@ -210,17 +211,7 @@
(v1.module->v1.lambda timeout start)))] (v1.module->v1.lambda timeout start)))]
[(v2 v2-transitional) ; XXX: Depreciate v2-transitional [(v2 v2-transitional) ; XXX: Depreciate v2-transitional
(let ([start (dynamic-require module-name 'start)] (let ([start (dynamic-require module-name 'start)]
[manager (with-handlers [manager (dynamic-require module-name 'manager)])
([exn:fail:contract?
(lambda (exn)
(define timeout (dynamic-require module-name 'timeout))
(define instance-expiration-handler
(dynamic-require module-name 'instance-expiration-handler))
(create-timeout-manager
instance-expiration-handler
timeouts-servlet-connection
timeout))])
(dynamic-require module-name 'manager))])
(make-servlet (current-custodian) (make-servlet (current-custodian)
(current-namespace) (current-namespace)
manager manager
@ -230,8 +221,10 @@
[(response? s) [(response? s)
(make-servlet (current-custodian) (make-servlet (current-custodian)
(current-namespace) (current-namespace)
(create-none-manager (create-timeout-manager
default-servlet-instance-expiration-handler) default-servlet-instance-expiration-handler
timeouts-servlet-connection
timeouts-servlet-connection)
(v0.response->v1.lambda s a-path))] (v0.response->v1.lambda s a-path))]
[else [else
(error 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)]))) (error 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)])))

View File

@ -151,6 +151,8 @@ This function writes a @scheme[configuration-table] to @scheme[path].
@scheme[make-servlet-namespace] procedure needed by the @scheme[make] functions @scheme[make-servlet-namespace] procedure needed by the @scheme[make] functions
of @file{dispatchers/dispatch-servlets.ss} and @file{dispatchers/dispatch-lang.ss}. of @file{dispatchers/dispatch-servlets.ss} and @file{dispatchers/dispatch-lang.ss}.
@; XXX Define make-servlet-namespace?
@; XXX Use actual keyword argument syntax @; XXX Use actual keyword argument syntax
@defproc[(make-make-servlet-namespace (#:to-be-copied-module-specs to-be-copied-module-specs (listof module-spec?))) @defproc[(make-make-servlet-namespace (#:to-be-copied-module-specs to-be-copied-module-specs (listof module-spec?)))

View File

@ -246,13 +246,13 @@ It defines a dispatcher construction procedure:
that runs servlets written in Scheme. that runs servlets written in Scheme.
@; XXX Add default manager arg @; XXX Add default manager arg
@; XXX Remove config:instances
@; XXX Remove config:scripts @; XXX Remove config:scripts
@; XXX Define make-servlet-namespace? @defproc[(make [config:scripts (box/c cache-table?)]
@defproc[(make [config:instances any/c]
[config:scripts (box/c cache-table?)]
[config:make-servlet-namespace make-servlet-namespace?]
[#:url->path url->path url->path?] [#:url->path url->path url->path?]
[#:make-servlet-namespace
make-servlet-namespace
make-servlet-namespace?
(make-make-servlet-namespace)]
[#:responders-servlet-loading [#:responders-servlet-loading
responders-servlet-loading responders-servlet-loading
((url url?) (exn any/c) . -> . response?) ((url url?) (exn any/c) . -> . response?)
@ -294,7 +294,6 @@ that runs servlets written in Scheme.
that runs servlets written in the Web Language. that runs servlets written in the Web Language.
@; XXX Don't include timeout logic in here, put it outside. @; XXX Don't include timeout logic in here, put it outside.
@; XXX Include configuration.scrbl exports
@defproc[(make [#:url->path url->path url->path?] @defproc[(make [#:url->path url->path url->path?]
[#:make-servlet-namespace make-servlet-namespace [#:make-servlet-namespace make-servlet-namespace
make-servlet-namespace? make-servlet-namespace?

View File

@ -15,7 +15,7 @@
(define (mkd p) (define (mkd p)
(define-values (! d) (define-values (! d)
(servlets:make #f (box (make-cache-table)) (make-make-servlet-namespace) (servlets:make (box (make-cache-table))
#:url->path (lambda _ (values p url0s)) #:url->path (lambda _ (values p url0s))
#:responders-servlet-loading #:responders-servlet-loading
(lambda (u exn) (lambda (u exn)

View File

@ -65,7 +65,8 @@
(collect-garbage) (collect-garbage)
((responders-collect-garbage (host-responders host-info))))) ((responders-collect-garbage (host-responders host-info)))))
(let-values ([(clear-cache! servlet-dispatch) (let-values ([(clear-cache! servlet-dispatch)
(servlets:make config:instances config:scripts config:make-servlet-namespace (servlets:make config:scripts
#:make-servlet-namespace config:make-servlet-namespace
#:url->path #:url->path
(fsmap:make-url->valid-path (fsmap:make-url->valid-path
(fsmap:make-url->path (paths-servlet (host-paths host-info)))) (fsmap:make-url->path (paths-servlet (host-paths host-info))))