add further configurable option: cache servlets
This commit is contained in:
parent
a920462ba1
commit
23dfce1dc7
|
@ -9,7 +9,7 @@
|
|||
)
|
||||
(begin
|
||||
|
||||
(define (get-option-change number-field return-address update-text)
|
||||
(define (get-option-change return-address update-text options)
|
||||
(send-html/suspend
|
||||
(lambda (new-url)
|
||||
`(html
|
||||
|
@ -19,28 +19,41 @@
|
|||
(h2 "Handler options")
|
||||
,(and (pair? update-text) update-text)
|
||||
(p "These are the runtime configurable options of the handler:")
|
||||
(table
|
||||
(servlet-form ,new-url
|
||||
(tr (td "Current instance lifetime: ")
|
||||
(td ,number-field)
|
||||
(td ,(make-submit-button "Change")))))
|
||||
(servlet-form
|
||||
,new-url
|
||||
POST
|
||||
(table
|
||||
,@(map (lambda (option)
|
||||
(let ((text (car option))
|
||||
(input-field (cadr option))
|
||||
(submit-button (caddr option)))
|
||||
`(tr (td ,text)
|
||||
(td ,input-field)
|
||||
(td ,submit-button))))
|
||||
options)))
|
||||
(hr)
|
||||
(URL ,(return-address new-url) "Return to main page")))
|
||||
)))
|
||||
|
||||
(define submit-timeout (make-submit-button "Change"))
|
||||
(define return-address (make-address))
|
||||
(define submit-cache (make-submit-button "Change"))
|
||||
|
||||
|
||||
(define (handler-options req . maybe-update-text)
|
||||
(let* ((update-text `(font (@ (color "red"))
|
||||
,(:optional maybe-update-text "")))
|
||||
(number-field
|
||||
(make-number-input-field `(@ ((value ,(options-instance-lifetime))))))
|
||||
(return-address (make-address))
|
||||
(req (get-option-change number-field return-address update-text))
|
||||
(make-number-input-field (options-instance-lifetime)))
|
||||
(cache-checkbox (make-checkbox-input-field (options-cache-servlets?)))
|
||||
(options `(("Current instance lifetime: " ,number-field ,submit-timeout)
|
||||
("Cache servlets?" ,cache-checkbox ,submit-cache)))
|
||||
(req (get-option-change return-address update-text options))
|
||||
(bindings (get-bindings req)))
|
||||
(cond
|
||||
((returned-via? return-address bindings)
|
||||
(return-to-main-page req))
|
||||
(else
|
||||
|
||||
((input-field-binding submit-timeout bindings)
|
||||
(with-fatal-error-handler
|
||||
(lambda (condition more)
|
||||
(handler-options req "Please enter a valid, positive integer number"))
|
||||
|
@ -52,7 +65,18 @@
|
|||
(handler-options req
|
||||
(format #f "Instance lifetime changed to ~a."
|
||||
(options-instance-lifetime))))
|
||||
(error "not a positive integer"))))))))
|
||||
(error "not a positive integer")))))
|
||||
((input-field-binding submit-cache bindings)
|
||||
(let ((cache-plugins? (if (input-field-binding cache-checkbox bindings)
|
||||
#t
|
||||
#f)))
|
||||
(set-options-cache-servlets? cache-plugins?)
|
||||
(handler-options req
|
||||
(format #f "Caching turned ~s"
|
||||
(if cache-plugins? "on" "off")))))
|
||||
(else
|
||||
(error "unexpected return" bindings)))))
|
||||
|
||||
|
||||
(define (return-to-main-page req)
|
||||
(send/finish (make-http-error-response http-status/moved-perm req
|
||||
|
|
Loading…
Reference in New Issue