Fix page caching

parent 2b7aeef7
;; -*- indent-tabs-mode:nil; coding: utf-8 -*-
;; Copyright (C) 2019
;; Copyright (C) 2019,2020
;; "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
;; Colt is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License
......
;; -*- indent-tabs-mode:nil; coding: utf-8 -*-
;; Copyright (C) 2019
;; Copyright (C) 2019,2020
;; "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
;; Colt is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License
......@@ -47,10 +47,11 @@
,(fix-decode (post-content post)))))))
(define (posts->atom)
(map atom-entry (get-all-posts #:latest-top? #t)))
(tpl->html (map atom-entry (get-all-posts #:latest-top? #t))))
(feed-define
atom
(options #:cache #t)
(lambda (rc)
(let ((blog-name (colt-conf-get 'blog-name))
(blog-url (colt-conf-get 'blog-url))
......@@ -58,7 +59,10 @@
(update-time (timestamp->atom-date
(string->number
(get-the-latest-post-update-time))))
(entries (tpl->html (posts->atom))))
(atom (try-to-get-page-from-cache rc)))
(response-emit
(view-render "atom" (the-environment))
(if atom
atom
(let ((entries (posts->atom)))
(cache-this-page rc (view-render "atom" (the-environment)))))
#:headers '((content-type application/atom+xml))))))
......@@ -40,7 +40,7 @@
(let ((blog-name (colt-conf-get 'blog-name))
(post-content (tpl->html
(generate-editable-index-content "simplified"))))
(view-render "index" (the-environment))))))
(cache-this-page rc (view-render "index" (the-environment)))))))
(get "/robots\\.txt"
(lambda ()
......
......@@ -25,9 +25,8 @@
#:use-module (artanis utils)
#:use-module (artanis irregex)
#:use-module (srfi srfi-1)
#:use-module ((rnrs) #:select (get-string-all get-string-n))
#:export (try-to-get-page-from-cache
update-index-posts-cache
#:use-module ((rnrs) #:select (get-string-n))
#:export (update-index-posts-cache
get-one-article
get-all-posts
get-posts-by-tag
......@@ -36,7 +35,6 @@
get-intro-page
get-the-latest-post
get-the-latest-post-update-time
gen-cache-file
get-article-content-by-name
get-intro-content
generate-editable-index-content
......@@ -62,16 +60,6 @@
(let ((check (meta-data-comment-status (post-meta-data p))))
(string=? check open)))
(define (gen-cache-file path)
(define-syntax-rule (-> str)
(string-trim-both
(irregex-replace/all "[/]+" str "_")
(lambda (x) (memv x '(#\sp #\_)))))
(let ((p (-> path)))
(if (string-null? p)
(format #f "~a/tmp/cache/index.html" (current-toplevel))
(format #f "~a/tmp/cache/~a.html" (current-toplevel) (-> path)))))
(define *all-post-objs* '())
(define *intro* '())
(define *all-tags* (make-hash-table))
......@@ -141,6 +129,8 @@
(post-timestamp (get-the-latest-post)))
(define (update-index-posts-cache)
(clear-content-cache "index")
(clear-content-cache "atom/feed")
(get-all-posts #:refresh? #t))
(define (get-posts-from-n-to-m n m posts-list)
......@@ -156,14 +146,6 @@
(get-string-n port (colt-conf-get 'abstract-size)))))
(map ->abstract posts-list))
(define (cache-this-page rc content)
(let* ((cache-file (gen-cache-file (rc-path rc)))
(fp (open-file cache-file "w")))
(display content fp)
(force-output fp)
(close fp)
content))
(define* (gen-one-post post mode #:optional (need-abstract? #f))
(define-syntax-rule (->url url-name)
(format #f "/archives/~a" (uri-decode url-name)))
......@@ -300,8 +282,3 @@
(define (get-intro-content)
(let ((intro (get-intro-page)))
(post-content (car intro))))
(define (try-to-get-page-from-cache rc)
(let ((cache-file (gen-cache-file (rc-path rc))))
(and (file-exists? cache-file)
(call-with-input-file cache-file get-string-all))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment