Gaucheで簡単なCGIを書いてみた

明確な目標は何もなしに、ブログ的なものをGaucheで書き始めた。とりあえずDBの根っこはできたので、goshからデータを投稿してhtmlを吐いてみた。

めっさ適当なソースコード。気がむいたときに少しずつ機能増強+抽象化していこう。dbmって初めて使うからキーにどんな値を使うのがよいのかよくわからんです。とりあえずサロゲートキーっぽくしてみた。今気がついたけど、わざわざ一つのDBに全部の値を詰めこまなくてもいいじゃん。データ用、各種設定用、みたいにDBを分ければいいのかな。

初期化は手動とか、DBをcloseしてないあたりは仕様です。

(use dbm)
(use dbm.fsdbm)
(use srfi-1)
(use gauche.collection)
(use text.html-lite)
(use www.cgi)
(use util.list)

(define (db-make-entry-record entry)
  (with-output-to-string
    (lambda ()
      (write
       (append-map
	(lambda (key)
	  `(,key ,(get-keyword key entry #f)))
	'(:time :title :content :comments))))))

(define (make-entry title
		    content
		    comments)
  (list :time (sys-time)
	:id (next-id)
	:title title
	:content content
	:comments comments))

(define (make-comment author
		      content)
  (list :time (sys-time)
	:author author
	:content content))

(define (entry-add-comment entry comment)
  (make-entry
   (get-keyword :title entry)
   (get-keyword :content entry)
   (append (get-keyword :comments entry)
	   (list comment))))

(define *db* (dbm-open <fsdbm> :path "blogdb" :rw-mode :write))

(define (db-update-entry entry)
  (begin 
    (dbm-put! *db* 
	      (number->string (get-keyword :id entry))
	      (db-make-entry-record entry))
    (db-refresh-largest-entry-id)
    #t))

(define (db-get key)
  (read-from-string (dbm-get *db* (x->string key))))

(define (db-get-entry-by-id id)
  (db-get id))

(define (db-get-next-entry-id)
  (+ 1 (db-get "largest-id")))
(define next-id db-get-next-entry-id)

(define (db-get-largest-entry-id)
  (apply max
	 (filter
	  identity
	  (dbm-map *db*
		   (lambda (key value) (string->number key))))))

(define (db-set-largest-entry-id! id)
  (dbm-put! *db* "largest-id" id))

(define (db-refresh-largest-entry-id)
  (let1 largest-id (db-get-largest-entry-id)
    (db-set-largest-entry-id! largest-id)))

(define (main args)
  (cgi-main
   (lambda (params)
     (list (cgi-header)
	   (html-doctype :type :xhtml-1.0-transitional)
	   (html:html
	    (html:head
	     (html:title "Hello world!"))
	    (html:body
	     (map
	      (lambda (entry)
		(html:div
		 (html:h3 (get-keyword :title entry))
		 (html:p (get-keyword :content entry))))
	      (get-new-entries))
	     (html:p "hello world in Gauche CGI")))
	   ))))

(define (get-new-entries . quantity)
  (let1 quantity (if (null? quantity) 5 (x->number (car quantity)))
    (map
     db-get-entry-by-id
     (take-right*
      (sort 
       (filter identity
	       (dbm-map *db*
			(lambda (key value) (string->number key)))))
      quantity))))