キャッシュ機構

Kahua

• 本家
• KahuaSeminar (臨時)
• 実験室

News

• ド素人とKahua (2007-07-04 13:58:34(+0900))
• Kahua Wish List (2006-09-28 06:48:12(+0900))
• Kahua Bug (2006-11-22 07:51:39(+0900))
• 日誌 (2007-07-04 14:00:20(+0900))
• Enjoy Gauche (2007-07-04 13:59:46(+0900))

Site Info

• Site Map
• Recent Changes

Kahua開発日記

Enjoy Gauche

まとめ中

cssノードとか、毎回結果が変らない物をキャッシュしたい。

マクロ展開時の字面範囲でキャッシュ

使い難い

(define-macro (with-cache thunk)
  (let* ((marker (list 'marker))
         (result (make-parameter marker)))
    `(begin
       (when (eq? ',marker (,result))
         (,result ,(thunk)))
       (,result))))

(define (hoge)
 (with-cache (lambda () (inc! 0))))

 >(hoge)
 1
 >(hoge)
 1 

ノードキャッシュ&httpのキャッシュを利用

ノードからS-treeへの変換は必要

(define with-http-cache
  (let* ((update-date (current-date))
         (update-seconds (time->seconds (date->time-utc update-date)))
         (modified-header (date->string update-date "~a, ~d ~b ~Y ~T ~z")))
    (define (not-modified)
      (let/pc _
        (html/
         (extra-header/
          (@/ (name "status")
              (value "304"))))))
    (define (last-modified!)
      (kahua-header-set! "Last-Modified" modified-header))
    (define (get-if-modified-since)
      (cond ((kahua-meta-ref "HTTP_IF_MODIFIED_SINCE")
             => (cut rfc822-date->date <>))
            (else #f)))

    (lambda (thunk)
      (let1 request-date (get-if-modified-since)
        (if (and request-date
                 (<= update-seconds
                     (time->seconds (date->time-utc request-date))))
            (not-modified)
          (begin
            (last-modified!)
            (thunk)))))))


(define-syntax define-static-entry
  (syntax-rules ()
    ((_ name body )
     (define-entry name
       (let1 d (delay body)
         (entry-lambda ()
           (with-http-cache
            (lambda ()
              (force d)))))))))

(define-static-entry hoge.css
  `((css
     (@ (charset "UTF-8"))

     (h1 (color red)))))

静的書き出し

(define (write-css)
  (kahua-write-static-file #`",(kahua-worker-type)/hoge.css"
   `((css
       …
   ()))

(kahua-add-hook! 'initial write-css)

Powered by Kahua