#lang scheme/base
(require web-server/servlet
web-server/managers/lru)
(require (planet "xhtml.ss" ("dherman" "xhtml.plt" 1 2))
(planet "parameter.ss" ("untyped" "unlib.plt" 3)))
(define (default-page title body)
(make-response/xhtml
`(html (head (title ,title)
(link ((media "screen")
(rel "stylesheet")
(href "style/style.css")
(type "text/css"))))
(body (div ((class "box"))
(div ((class "content"))
(h1 ,title)
(div ((class "body"))
,@body)))))))
(define (default-instance-expiration-handler exn)
(default-page "Page Has Expired"
'((p ((class "message"))
"Sorry, this page has expired. Please go back "
(a ((href "/")) "home")))))
(define (default-servlet request)
(default-page "Hello!"
'((p "Hello! This is my new website. Nothing to see yet, but check back soon!"))))
(define-parameter current-instance-expiration-handler
default-instance-expiration-handler
(make-guard procedure? "procedure?")
with-instance-expiration-handler)
(define-parameter current-servlet-function
default-servlet
(make-guard procedure? "procedure?")
with-servlet-function)
(define (instance-expiration-handler exn)
((current-instance-expiration-handler) exn))
(define interface-version 'v2)
(define manager
(let ([memory-threshold (* 64 1024 1024)]) (create-LRU-manager
instance-expiration-handler
5
(* 10 60)
(lambda ()
(define memory-use (current-memory-use))
(define collect? (or (>= memory-use memory-threshold)
(< memory-use 0)))
collect?)
#:initial-count 24
#:inform-p (lambda args
(void)))))
(define (start request)
((current-servlet-function) request))
(provide interface-version
manager
start
with-servlet-function
with-instance-expiration-handler)