Gauche:CGI:スケジュール予定表:Shiro版:ver3

データベース出現

では、いよいよ各日付の予定を格納できるようにしてみよう。

サーバ側にデータを置いておくにはいくつか方法があるが、 単純にキー(この場合は日付)と値(この場合は予定)を結びつけるだけなら dbmが楽ちんだ。データ量に対するスケーラビリティも、まあ小さな アプリならあまり問題にならない(サーバのスペックにもよるが、 データファイルが数MBくらい、あるいはエントリ数が数千、という 程度では問題は出ない)。但し、非常に頻繁にアクセスされる cgiだと、アクセスが重なった時にロックを獲得できず 「一時的エラー」となってしまう場合がある。

データ量がそれほど多くなく、読み込みアクセスが頻繁で、 しかし書き込みはあまり多くない、という場合は、素直に S式にダンプしておく方がレスポンスが良い場合もある (S式へのダンプは一種のシリアライズと言える)。 もちろん、書き込み時には一時ファイルに書き出してrenameするのだ。 書き込む人が一人だけ、というような場合は特に、書き込みの衝突を 考慮する必要が少ないので、この方法はうまく行く。

書き込みも読み出しも頻繁だとか、データ量が大きくなってきたとか いう場合は、本格的なデータベースの使用を検討することも 必要になろう。

このように、適切なデータの格納方式はアクセスパターンによって 異なる。スケールの変化が見込まれている場合は、データベース アクセスレイヤを最初から抽象化しておいて、後で実装を簡単に 変えられるようにしておくのもひとつの手だ。

もっとも、今回は最短距離ってことでそういうことは忘れて、 安直にgdbmを使うことにする。まずはデータベース名を定義しといて…

(use dbm.gdbm)

(define *db-name* "/home/shiro/data/cal.data")

予定データは日付 ("YYYY-MM-DD") をキーにして格納しておく ことにしよう。cmd-show-planはこんなふうになる。

(define (cmd-show-plan y m d)
  (let* ((db (dbm-open <gdbm> :path *db-name* :rw-mode :write))
         (plan (dbm-get db #`",|y|-,|m|-,|d|" "")))
    (dbm-close db)
    (page
     (calendar (make-month m y))
     (html:form
      (html:p #`",|y|年,|m|月,|d|日の予定")
      (html:input :type "hidden" :name "c" :value "e")
      (html:input :type "hidden" :name "y" :value (x->string y))
      (html:input :type "hidden" :name "m" :value (x->string m))
      (html:input :type "hidden" :name "d" :value (x->string d))
      (html:p (html:textarea :rows 8 :cols 40 :name "p"
                             (html-escape-string plan)))
      (html:p (html:input :type "submit" :name "submit" :value "変更"))))))

dbm-openで、:rw-mode :writeでデータベースをオープンしているのは、 こうするとデータベースが無かった場合に自動的に作られるから。 ただ、この関数はread onlyで良いはずなのに常にwriteでオープンすると、 dbのロックがかぶる可能性は高くなる。

予定データの受け取り

textareaに表示された予定をユーザは編集して、submitする。 その場合、パラメータ"c" に文字列 "e"が、そして パラメータ"p"に新しい予定のテキストが入って来るはずだ。 パラメータ"c"が"e"なら新しい予定をデータベースに書き込めばよい。 main関数はこのようになる。関数cmd-change-planはこれから書く。

(define (main args)
  (cgi-main
   (lambda (params)
     (let ((y (cgi-get-parameter "y" params :convert x->integer))
           (m (cgi-get-parameter "m" params :convert x->integer))
           (d (cgi-get-parameter "d" params :convert x->integer))
           (cmd (cgi-get-parameter "c" params))
           (plan (cgi-get-parameter "p" params
                                    :convert (cut ces-convert <> "*jp"))))
       (if (and y m d)
         (if (equal? cmd "e")
           (cmd-change-plan y m d plan)
           (cmd-show-plan y m d))
         (cmd-show-calendar y m))
       ))))

uri-decodeなどの処理はcgi-mainが行ってくれている。 ただ、日本語を扱うアプリケーションの場合、文字コードが必ずしも こちらの意図したエンコーディングで来ているとは限らない。 これもまじめにやろうとするとかなり面倒な問題なんだが、 簡単なスクリプトならコード推測で変換をかけてしまっても、だいたいはうまく動く (GaucheRefj:ces-convert)。

おっと、cgiから返す文書も、エンコーディングを明記しといた方がいいね。

(define (page . content)
  `(,(cgi-header
      :content-type #`"text/html; char-set=,(gauche-character-encoding)")
    ,(html:html
      (html:head (html:title "簡易スケジュール表"))
      (apply html:body content))))

ほんとは上のやり方は正しくない (Gaucheのnative encodingがShift JISや noneの場合まずい)。別の方法としては、例えばchar-set=utf-8で固定する、 という方法もある (see GaucheRefj:cgi-output-character-encoding)。

データのストア

データの格納は、単に渡されたplanをdbmにしまって、 改めて当日のページを表示するだけ。当日のページの表示には cmd-show-planがそのまま使える。

ただ、formデータのやりとりをPOSTメソッドで行っている場合、 ここで直接HTMLを生成してしまうと、ブラウザ側でreloadした時に データが再postされてしまうという問題が出ることがある。 こういうデータを変更する動作は直接HTMLを生成するのではなく、 結果表示のページへとredirectしておくのが無難だ。

(define (cmd-change-plan y m d plan)
  (let* ((db (dbm-open <gdbm> :path *db-name* :rw-mode :write)))
    (dbm-put! db #`",|y|-,|m|-,|d|" plan)
    (dbm-close db)
    (cgi-header :status "302 Moved"
                :location #`"?y=,|y|&m=,|m|&d=,|d|")))

まとめ

まとめるとこんな感じ。 まだとってもプリミティブだけど、LL Weekendのお題の範囲は一応カバーしてるかな。

#!/usr/bin/env gosh
(use srfi-1)
(use srfi-19)
(use util.list)
(use text.html-lite)
(use gauche.sequence)
(use gauche.charconv)
(use dbm.gdbm)
(use www.cgi)

(define *db-name* "/home/shiro/data/cal.data")

;;;
;;; Calendar Logic
;;;
(define (make-month m y)
  (make-date 0 0 0 0 1 m y (date-zone-offset (current-date))))

(define (first-day-of-month date)
  (make-month (date-month date) (date-year date)))

(define (days-of-month date)
  (inexact->exact
   (- (date->modified-julian-day (next-month date))
      (date->modified-julian-day (first-day-of-month date)))))

(define (next-month date)
  (if (= (date-month date) 12)
    (make-month 1 (+ (date-year date) 1))
    (make-month (+ (date-month date) 1) (date-year date))))

(define (prev-month date)
  (if (= (date-month date) 1)
    (make-month 12 (- (date-year date) 1))
    (make-month (- (date-month date) 1) (date-year date))))

;; returns list slices for calendar. 
(define (date-slices-of-month date)
  (slices (append (make-list (date-week-day (first-day-of-month date)) #f)
                  (iota (days-of-month date) 1))
          7 #t #f))

;;;
;;; Display
;;;
(define (month->link date content)
  (html:a :href #`"?y=,(date-year date)&m=,(date-month date)" content ))

(define (date-cell year month date)
  (if date
    (html:a :href #`"?y=,|year|&m=,|month|&d=,|date|" date)
    ""))

(define (calendar date)
  (html:table
   (html:tr (html:td (month->link (prev-month date) "←"))
            (html:td :colspan 5 :align "center"
                     #`",(date-year date)/,(date-month date)")
            (html:td (month->link (next-month date) "→")))
   (html:tr (map html:td "日月火水木金土"))
   (map (lambda (w)
          (html:tr
           (map (lambda (d)
                  (html:td (date-cell (date-year date) (date-month date) d)))
                w)))
        (date-slices-of-month date))))

(define (page . content)
  `(,(cgi-header
      :content-type #`"text/html; char-set=,(gauche-character-encoding)")
    ,(html:html
      (html:head (html:title "簡易スケジュール表"))
      (apply html:body content))))

;;;
;;; Commands
;;;
(define (cmd-show-calendar y m)
  (page
   (if (and y m (<= 1 m 12) (<= 1753 y))
     (calendar (make-month m y))
     (calendar (current-date)))))

(define (cmd-show-plan y m d)
  (let* ((db (dbm-open <gdbm> :path *db-name* :rw-mode :write))
         (plan (dbm-get db #`",|y|-,|m|-,|d|" "")))
    (dbm-close db)
    (page
     (calendar (make-month m y))
     (html:form
      (html:p #`",|y|年,|m|月,|d|日の予定")
      (html:input :type "hidden" :name "c" :value "e")
      (html:input :type "hidden" :name "y" :value (x->string y))
      (html:input :type "hidden" :name "m" :value (x->string m))
      (html:input :type "hidden" :name "d" :value (x->string d))
      (html:p (html:textarea :rows 8 :cols 40 :name "p"
                             (html-escape-string plan)))
      (html:p (html:input :type "submit" :name "submit" :value "変更"))))))

(define (cmd-change-plan y m d plan)
  (let* ((db (dbm-open <gdbm> :path *db-name* :rw-mode :write)))
    (dbm-put! db #`",|y|-,|m|-,|d|" plan)
    (dbm-close db)
    (cgi-header :status "302 Moved"
                :location #`"?y=,|y|&m=,|m|&d=,|d|")))

;;;
;;; Main entry
;;;
(define (main args)
  (cgi-main
   (lambda (params)
     (let ((y (cgi-get-parameter "y" params :convert x->integer))
           (m (cgi-get-parameter "m" params :convert x->integer))
           (d (cgi-get-parameter "d" params :convert x->integer))
           (cmd (cgi-get-parameter "c" params))
           (plan (cgi-get-parameter "p" params
                                    :convert (cut ces-convert <> "*jp"))))
       (if (and y m d)
         (if (equal? cmd "e")
           (cmd-change-plan y m d plan)
           (cmd-show-plan y m d))
         (cmd-show-calendar y m))
       ))))

;; Local variables:
;; mode: scheme
;; end: