スケジュール入力用のフォームが表示できたので、こんどはデータを保存出来るようにしてみましょう。
「どんなデータベースを使うのが良いか?」で見たように、データ量がごく少量でアクセスも少ないならS式のままファイルに格納する方法がまず考えられます。また、大量のデータを扱うにはRDBMSを使う方法もあります。
ここではRDBMSを使うまでもないデータ量であると判断し、dbm.fsdbmライブラリを使うことにします。
(use dbm.fsdbm)
(define *db-name* "/home/yasuyuki/data/schedule.data")
(use dbm.fsdbm)を評価させてdbm.fsdbmライブラリが使えるようにしておきます。データの保存場所のフルパス名に*db-name*という名前をつけておきます。
(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データベースからデータを検索する」で説明した方法で、スケジュールデータを日付をキーにして読み込むようにcmd-show-plan手続きを書き直しました。textareaにはデータベースから読み込んだplan を表示します。
スケジュール入力フォームに入力された予定データを受け取るにはどうしたらよいでしょうか?
予定データを受け取れるようにmain手続きを書き直しましょう。
(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"))))
(cgi-output-character-encoding 'utf-8)
(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))
))))
パラメータcに"e"が渡されたとき、パラメータpの値を引数にcmd-change-plan手続きを評価しています。
cgi-get-parameter手続きに:convertオプションを渡して入力された文字コードを自動判定して変換しています。
CGIで扱う文字コードも明示的に指定しておきます。上記ではcgi-output-character-encoding手続きを使ってUTF-8を指定しています。
:convertの右に書かれた(cut ces-convert <> "*JP")は次の式に展開されます。
(lambda (x) (ces-convert x "*JP"))
cutは手続きを作り出します。もちろんlambdaでも書けますが、cutを使うと記述が簡潔になります。
「文字コードを変換する」で見たように、ces-convert手続きに"*JP"オプションを指定すると、入力文字列が日本語であるとみなし、文字コードを自動判定して変換してくれます。
データの保存はcmd-change-plan手続きで行います。
(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|")))
「dbmデータベースにデータを書き込む」で説明したdbi-put!手続きを使って、日付をキーにして予定データを書き込んでいます。
最後にHTTPステータス"302 Moved"を返してリダイレクトしているのは、フォームを再読み込みされたときに2回以上POSTされるのを防ぐためです。
ここまでのコードの全体は以下の通りです。
#!/usr/local/bin/gosh
(use util.list)
(use text.html-lite)
(use srfi-1)
(use srfi-19)
(use www.cgi)
(use gauche.sequence)
(use dbm.fsdbm)
(use gauche.charconv)
(define *db-name* "/home/yasuyuki/data/schedule.data")
(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 (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))))
(define (days-of-month date)
(inexact->exact
(round
(- (date->modified-julian-day (next-month date))
(date->modified-julian-day (first-day-of-month date))))))
(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))
(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)
,(html:html
(html:head (html:title "簡易スケジュール表"))
(apply html:body content))))
(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 <fsdbm> :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 <fsdbm> :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|")))
(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"))))
(cgi-output-character-encoding 'utf-8)
(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))
))))
日付をクリックして予定を入力し、「変更」ボタンを押すと予定データがデータベースに保存されています。