prog

frontpage - thread list - new thread - preferences - ?

How can I run my own instance of this

292 2020-06-16 02:47

[2/2]

$ cat full.diff
--- bbs.scm	2020-06-15 23:08:54.965513796 +0000
+++ bbs-edit.scm	2020-06-15 22:57:40.125009000 +0000
@@ -11,14 +11,24 @@
 (load "lib/utils")
 (load "deps/irregex")
 (load "deps/srfi-26")
-(load "deps/httpio")
-(load "deps/server")
+;(load "deps/httpio")
+;(load "deps/server")
 (load "lib/html")
 (load "lib/parameters")
 (load "lib/markup")
 (load "templates")
 
 
+(define (serve-file path #!optional headers)
+  (if (default-object? headers) (set! headers '()))
+  (let ((content (read-file path)))
+    `(200 ,headers ,content)))
+
+(define (read-file filename)
+  (call-with-input-file filename
+                        (lambda (port)
+                          (read-string (char-set) port))))
+
 (define (get-form-hash)
   "TODO"
   (call-with-input-file "hash" read))
@@ -31,7 +41,7 @@
 (define (make-abs-path . args)
   (string-join (cons "" args) "/"))
 
-(define server (create-server))
+;(define server (create-server))
 
 (define (make-response template)
   `(200 ,(list (make-http-header 'content-type "text/html; charset=utf-8"))
@@ -42,12 +52,19 @@
   (serve-file path (list (make-http-header 'content-type "text/html; charset=utf-8")
 			 (make-http-header 'cache-control "Private"))))
 
+(define (write-and-serve-text path text)
+  (with-output-to-file path (lambda () (write-string text)))
+  (list 200
+        (list (make-http-header 'content-type "text/html; charset=utf-8")
+              (make-http-header 'cache-control "Private"))
+        text))
+
 ;;; static files
-(get server (serve-static "static") '("static"))
+;(get server (serve-static "static") '("static"))
 
-(get server (lambda (req params) (serve-file "static/favicon.ico")) '("favicon.ico"))
+;(get server (lambda (req params) (serve-file "static/favicon.ico")) '("favicon.ico"))
 
-(add-handler server (lambda (req params) (route req)))
+;(add-handler server (lambda (req params) (route req)))
 
 (define (ignore-qstring fullpath)
   (let ((l (string-split fullpath #\?)))
@@ -149,7 +166,10 @@
 				   (lambda (e) (vector-ref rangeonce (car e))))))
 	     (cond (norange
 		    (if (not (file-exists? cache))
-			(write-and-serve cache (thread-template board thread posts headline filter-func))
+                        (let ((old (name-cache-old cache)))
+                          (if (file-exists? old)
+                              (view-thread-ihg cache old board thread posts headline)
+                              (write-and-serve cache (thread-template board thread posts headline filter-func))))
 			(serve-file cache)))
                    ((and (string->number range)
                          (> (string->number range) (length posts)))
@@ -185,6 +205,28 @@
               r3)
     vec))
 
+(define (name-cache-old cache)
+  (string-append cache "-old"))
+
+; incremental html generation
+(define (view-thread-ihg cachepath cacheoldpath board thread posts headline)
+  (let* ((oldtext   (read-file cacheoldpath))
+         (lastadt   (string-search-backward "</A></DT>" oldtext))
+         (adtpos    (- lastadt 9))
+         (prevgt    (substring-search-backward ">" oldtext 0 adtpos))
+         (postlimit (string->number (substring oldtext prevgt adtpos)))
+         (newfilter (lambda (e) (>= (car e) postlimit)))
+         (prevdt    (substring-search-backward "<DT>" oldtext 0 (- prevgt 1)))
+         (newsxml   (thread-template board thread posts headline newfilter))
+         (newtext   (with-output-to-string (lambda () (sxml->html newsxml))))
+         (firstdl   (string-search-forward "<DL>" newtext))
+         (merged    (string-append
+                      (string-head oldtext (- prevdt 4))
+                      (string-tail newtext (+ firstdl 5))))
+         (result    (write-and-serve-text cachepath merged)))
+    (delete-file cacheoldpath)
+    result))
+
 (define (view-list board)
   (let* ((path (make-path *sexp* board "list"))
          (cache (make-path *html* board "list"))
@@ -232,7 +274,7 @@
 							       (vip . ,vip)
 							       (content . ,sxml)))))
 			     (call-with-output-file path (lambda (port) (write t port)))
-			     (if (file-exists? cache) (delete-file cache))
+			     (if (file-exists? cache) (rename-file cache (name-cache-old cache)))
 			     (if vip
 				 (update-post-count board thread date post-number)
 				 (update-thread-list board (string->number thread) date post-number))
@@ -414,4 +456,4 @@
                     (decode-formdata message)
                     (cdr validation)))))
 
-(listen server (string->number (car (command-line))))
+;(listen server (string->number (car (command-line))))

Timing for adding one post, with a 39-old at 285:

$ rm data/html/prog/39
$ mit-scheme --load bbs-edit.scm --load test.scm 
[...]
1 ]=> (timeit (lambda () (view-thread "prog" "39") 'ok))
.12 .01 .12
;Value: ok

It's about 9 times faster and practically as fast as serving from cache. When this thread fills, we have a few other triple-digit post counts to test on. When the templates are updated, like when adding the board list, a drop-caches.sh of some sort will have to be run. If templates.scm:format-thread is drastically changed, bbs.scm:view-thread-ihg will need the equivalent update.

301