Gauche:CGI:スケジュール予定表:Shiro版
カレンダー表示して、各日付に対して予定を書き込めるようにする、 というcgiスクリプト。いくつも解法があると思います。ここでは Gaucheのライブラリを活用して最短距離でとにかく動かし、その後で 機能をいろいろつけてゆく、という方向で、開発の様子を書いてみます。 チュートリアルにもなればいいかな。
何はともあれカレンダー
まずは、カレンダー機能を実現してみましょうか。
カレンダーの基本関数
カレンダーを作るのに必要なのは、与えられた月の最初の日の曜日とその月の 日数を知ることだ。基本的な材料(閏年の公式、曜日を求める公式など) から組み立ててもいいのだが、めんどくさい。せっかくSRFI-19で 基本的な日付を扱う関数が定義されているので、それを使ってしまおう。 (参考: GaucheRefj:srfi-19)。 また、次の月、前の月を求める関数も必要なので作っておく。
(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
(- (date->modified-julian-day (next-month date))
(date->modified-julian-day (first-day-of-month date)))))
make-monthというのはちょっとミスリーディングな名前だが、 yy年mm月1日の日付を返す関数だ。make-dateが似たようなパターンで 多く使われるので括り出しといた。
<date>は構造体なので演算がやりにくい。日付の差などを取るには ある基準日からの日数に変換するのが楽だ。srfi-19ではjulian-dayおよび modified-julian-dayがその用途に用意されている (両者は基準日が 異なるだけ)。
さて、カレンダーは数字を一週間ごとに区切って並べるので、 表示形式(HTML)のことはとりあえず置いといて、リストでカレンダーを 表現してみよう。例えば31日あって、1日が火曜である月のカレンダーなら、 次のようなリストにする。
((#f #f 1 2 3 4 5) (6 7 8 9 10 11 12) (13 14 15 16 17 18 19) (20 21 22 23 24 25 26) (27 28 29 30 31 #f #f))
リストを指定の長さに切りそろえてゆくslices (GaucheRefj:slices)という 関数がutil.listモジュールにある。やりたい操作は、 「開始日までの曜日の数だけ#fを並べたリストと、1〜31までの数字を 並べたリストをつなげて、それを7つづつに切りそろえる。 最後の足りないぶぶんには#fを補う」、ということになる。
(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))
ここまでで基本的なカレンダー関数は揃った。 これらの式を評価すれば、インタラクティブに動作を確認することが出来る。 (srfi-1, srfi-19, util.listをuseしておくのを忘れずに)。
gosh> (first-day-of-month (current-date)) #<date 2004/08/01 00:00:00.000000000 (-36000)> gosh> (next-month (current-date)) #<date 2004/09/01 00:00:00.000000000 (-36000)> gosh> (prev-month (current-date)) #<date 2004/07/01 00:00:00.000000000 (-36000)> gosh> (next-month (next-month (current-date))) #<date 2004/10/01 00:00:00.000000000 (-36000)> gosh> (date-slices-of-month (current-date)) ((1 2 3 4 5 6 7) (8 9 10 11 12 13 14) (15 16 17 18 19 20 21) (22 23 24 25 26 27 28) (29 30 31 #f #f #f #f)) gosh> (date-slices-of-month (next-month (current-date))) ((#f #f #f 1 2 3 4) (5 6 7 8 9 10 11) (12 13 14 15 16 17 18) (19 20 21 22 23 24 25) (26 27 28 29 30 #f #f))
カレンダーのtable表示
まず、作成するテーブルのイメージを持っておこう。こんなかんじかな。
← 2004/8 → 日 月 火 水 木 金 土 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ...
左上、右上の矢印はそれぞれ前月、次月へのリンク、また各日付は、 その日の予定メモへのリンクと。
リンクの仕様をどうするか、なんてのを深く考えるのは後回し。 リンクを貼る部分だけを関数で括り出しておけば、あとからどうにでも 変えられる。今はとりあえず必要な情報だけをそれらしくqueryパラメータに 埋め込んどこう。
HTMLを生成するにもいくつか方法があるが、簡単なcgiスクリプトだったら text.html-liteモジュールを使ってしまうのが楽だ (GaucheRefj:text.html-lite)。 もひとつ、以下のコードでは文字列に対するmapを使っているので、 gauche.sequenceもuseしておく。(リストを使ってもいいけど、 らくちんでしょ)。
(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))))
動作の確認をするには、text.treeモジュールもuseして、 calendar関数の結果をwrite-treeで表示してみせるのが良いだろう。
gosh> (write-tree (calendar (current-date))) <table><tr><td><a href="?y=2004&m=7">←</a ></td ><td colspan="5" align="center">2004/8</td ><td><a href="?y=2004&m=9">→</a ></td ></tr ><tr><td>日</td ><td>月</td ><td>火</td ... (省略) ...
cgiにする
HTMLが出てるみたいなんで、cgiにして動かしてみようか。 最初はとにかく現在の月のカレンダーを表示する、というところに とどめておく。
www.cgiモジュールを使ってみる。 www.cgiモジュールでは色々な機能が提供されているけど、 とりあえず何かを表示するだけなら、 次のように簡単なコードで済む。
(define (main args)
(cgi-main
(lambda (params)
(list (cgi-header)
(html:html
(html:head (html:title "簡易スケジュール表"))
(html:body (calendar (current-date)))))
)))
今回のまとめ
これまでのコードをまとめるとこんな感じになる。 適当なところにcal1.cgiみたいな名前で置いて、実行パーミッションをつけて、 webブラウザからアクセスしてみよう。 パラメータの解析はしてないので、どのリンクをつついても 現在の月しか表示されないけど。
もしInternal Server Errorなどが出てしまった場合は、 cal1.cgiを直接コマンドラインから起動して問題が出ないかどうかを 調べることができる。 コマンドラインから起動した場合、次のような表示が出て入力待ちに なる(これはcgi-mainが出している）。 ここで y=2004 などのパラメータを渡すことができる。 何も渡すものが無ければEOT (通常は^D)をタイプする。
[shiro@scherzo shiro.dreamhost.com]$ ./cal1.cgi Enter parameters (name=value). ^D to stop.
正常なら、Content-Type: text/htmlに続いてHTMLが標準出力に 出力されるはず。エラーになった場合はエラーメッセージを 手がかりに問題を解決する。
コマンドラインからだと正常に動くのに、webサーバ経由だと 動かない、という場合は、パーミッション (webサーバのuser idで cgiスクリプトが実行可能か)、cgi実行環境からgoshは見えているか、 またhttpdが正しく設定されているか、等を調べることになる。
#!/usr/bin/env gosh
(use srfi-1)
(use srfi-19)
(use util.list)
(use text.html-lite)
(use gauche.sequence)
(use www.cgi)
;;;
;;; 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))))
;;;
;;; Main entry
;;;
(define (main args)
(cgi-main
(lambda (params)
(list (cgi-header)
(html:html
(html:head (html:title "簡易スケジュール表"))
(html:body (calendar (current-date)))))
)))
;; Local variables:
;; mode: scheme
;; end:
パラメータの受け取り
では、Queryパラメータを受け取れるようにして、 月の移動を実現してみよう。
paramsの意味
先ほどのスクリプトでは、cgi-mainに(lambda (params) ...) という 関数を渡していたが、引数paramsは使っていなかった。 paramsには、httpのGETやPOSTメソッドで渡ってきたパラメータに関する 情報が入っている。このへんはまともに扱おうとすると色々面倒なのだが、 cgi-mainは(lambda (params) ...) を呼び出す前にそういう面倒を解決してくれる。
paramsの正体は単なるリストなのだが、さらにparamsから必要なパラメータを 取り出す関数も用意されている(GaucheRefj:cgi-get-parameter)。 通常は、paramsを単なるopaqueなデータとして扱えば十分だ。
年、月、日のデータをそれぞれ "y", "m", "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)))
(if (and y m d)
(cmd-show-plan y m d)
(cmd-show-calendar y m))
))))
cmd-show-planやcmd-show-calendarはこれから書く。
任意月のカレンダー
カレンダーの表示では、年月が与えられている場合とそうでない場合が あり得る。年月が与えられ、それが正常値であればその月を、 そうでなければパラメータは無視して現在のカレンダーを表示する ようにしようか。
(define (cmd-show-calendar y m)
(page
(if (and y m (<= 1 m 12) (<= 1753 y))
(calendar (make-month m y))
(calendar (current-date)))))
グレゴリオ歴は1752年9月からだそうなので (see cal(1))、 1753年以降の月だけ扱うことにする。
また、htmlページを表示するための決まり文句はどうせ共通なので、 別関数pageにまとめておく。これで、内容を作成する関数は 内容だけに集中することができる。
(define (page . content)
`(,(cgi-header)
,(html:html
(html:head (html:title "簡易スケジュール表"))
(apply html:body content))))
各日付のエントリ
年月日が指定された場合は、予定記入フォームを表示することに しよう。サーバ側で予定をどう格納しておくかは後回しにして、 カタチだけ整える。
(define (cmd-show-plan y m d)
(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 "予定を記入")))
(html:p (html:input :type "submit" :name "submit" :value "変更")))))
あ、ほんとはここでもy, m, d の各パラメータが正常値に入って いるかどうか検査が必要なんだな。なんか面倒になったので 読者への宿題としておこう :-)
まとめ
変わってない分も含めて全部一緒にするとこんなかんじ。
#!/usr/bin/env gosh
(use srfi-1)
(use srfi-19)
(use util.list)
(use text.html-lite)
(use gauche.sequence)
(use www.cgi)
;;;
;;; 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)
,(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)
(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 "予定を記入")))
(html:p (html:input :type "submit" :name "submit" :value "変更")))))
;;;
;;; 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)))
(if (and y m d)
(cmd-show-plan y m d)
(cmd-show-calendar y m))
))))
;; Local variables:
;; mode: scheme
;; end:
データベース出現
では、いよいよ各日付の予定を格納できるようにしてみよう。
サーバ側にデータを置いておくにはいくつか方法があるが、 単純にキー(この場合は日付)と値(この場合は予定)を結びつけるだけなら 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:
近代化
さて、ここまで駆け足で作ってきたのだが、改めて見直してみると 色々気になることがある。
- 生成されるHTMLドキュメントにdoctype宣言がない。ので行儀が悪い。
- 予定を見るだけでもtextareaが表示されるのは何だなあ。
- 予定のある日と無い日くらいはカレンダーで見分けたい
- dbへのアクセス部分がなんか汚い
そこで、気になるところをちょこまか直していってみよう。 ここで肝心なのは、インクリメンタルに変更してゆくこと、 つまり、常に動く状態にしつつ変えて行くことである。 一度にいくつものことがらを変えようとしたり、全く動かない状態に してしまうより、いつでも動いているものを手元に持っておく方が ずっと気が楽だ。
dbまわりの抽象化
現在は、dbアクセスが必要になったところでdbをオープンしている。 これは必要最小限しかdbに触らないという意味では好ましいのだけれど、 例えば予定のある日をカレンダーで色つけしたい、なんてことを 考えるとそこでまたdbのオープンが必要になったりして、 コードがちらかってくる。性能はたいして問題にならないスクリプトだし、 コマンドの処理を行っている時は常にデータベースがオープンされている ようにしてもあまり問題はないだろう。
さて、オープンされてるデータベースはあちこちから参照されるから、 グローバルに見えていてほしい。グローバル変数を使ってもいいんだけど、 グローバルな状態を変数に直接置いとくのは、なんとなく後ろめたい。 だってグローバル変数は使わない方がいいって習わなかった?
パラメータを使うと、後ろめたさを感じずにグローバルな状態を扱うことができる。
(use gauche.parameter) (define db (make-parameter #f))
いや、そもそも「グローバル変数」云々ってのはSchemeだとちょっと意味が 怪しくて、というのは関数定義だってグローバルな変数へのlambdaクロージャの 束縛にすぎないからね。気持ちが悪いのは、グローバルな束縛がプログラムの 実行中に変化してゆくこと---そのために特定時点でのプログラムの意味を 把握するのが難しくなること、なんだ。
(このことは、ひとことでは説明しにくいけれど、ひとつ例をあげてみよう。 この開発の最初の頃にやったように、低レベルの細かい関数を書いた時に それをインタラクティブに実行して確かめてみるってことはよくやるよね。 もしそこで、そういう低レベル関数の動作がたくさんのグローバル変数に 依存してたとしたら? 関数のデバッグ中なんかに、途中のエラーによって グローバル変数の状態が意図しない値になってしまうことは良くある。 その状態で低レベル関数を走らせて、思うように動かなくて悩むことになる)。
パラメータは、グローバルな状態を関数で包むようなものだ。上のように 書いておくと、 関数呼び出し(db)でパラメータの現在の値が返されて、 (db <value>) でパラメータにあらたな値を与えることができる。
もっとも、(db <value>)で無秩序に値を変更してしまっては、グローバル変数と 同じことになるので、どうしても必要な場合以外は避けたほうがいい。 替わりに、parameterizeというマクロを使う。
(parameterize (db <value>) body ...)
このマクロは、bodyの実行中「だけ」パラメータdbの値を<value>に変える。 bodyが終了したり、エラーで脱出したりした時にはdbの値はparameterize 呼び出し前の値に復元される。(さらに、継続を使ったコルーチン呼び出しで 制御が外側に移った時にもdbの値は復元される。もういちどbody内の継続が 呼び出されれば、再びdbの値は<value>になる)。
他にもparameterはいくつか便利な機能があるので、GaucheRefj:gauche.parameter を参照されたし。
さて、parameterの話ばかりしててもしかたない。もうひとつ大事なのは、 何があっても開いたデータベースは閉じることだ。そのへんをマクロに閉じ込めて しまおう。ついでに、DBのキーを生成するところも低レベルで汚いから 関数にして抽象化しておく。
(define-syntax with-db
(syntax-rules ()
((with-db (db path) . body)
(parameterize ((db (dbm-open <gdbm> :path path :rw-mode :write)))
(with-error-handler (lambda (e) (dbm-close (db)) (raise e))
(lambda ()
(begin0
(begin . body)
(dbm-close (db)))))))))
(define (db-key y m d) #`",|y|-,|m|-,|d|")
このマクロによって、main関数の方でコマンドの処理をこんなふうに囲っておけば：
(with-db (db *db-name*)
(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))
各コマンド内では (db) でオープンされたdbが得られるというわけだ。 例えばcmd-change-planはこんなふうになる。
(define (cmd-change-plan y m d plan)
(dbm-put! (db) (db-key y m d) plan)
(cgi-header :status "302 Moved"
:location #`"?y=,|y|&m=,|m|&d=,|d|"))
cmd-show-planも同様に変えればよい。
予定のある日に色をつける
さて、これで主要な処理中はどこでもデータベースにアクセスできるようになった。 予定のある日に色をつけるには、日付のセルを生成する関数内で 予定の有無を調べて処理を変えればいい。
(define (date-cell year month date)
(if date
(html:a :href #`"?y=,|year|&m=,|month|&d=,|date|"
(if (dbm-exists? (db) (db-key year month date))
(html:span :class "planned" date)
date))
""))
ここではあくまでお行儀良く、spanで囲っといてCSSで色をつけさせることにしよう。
(define *style* "
span.planned {
background-color : #ffcccc;
}
")
(define (page . content)
`(,(cgi-header
:content-type #`"text/html; char-set=,(gauche-character-encoding)")
,(html-doctype :type :xhtml-1.0-transitional)
,(html:html
(html:head (html:title "簡易スケジュール表")
(html:style :type "text/css" *style*))
(apply html:body content))))
CSSを*style*で定義しといて、pageの定義を変えてそれをhead内に 埋め込むようにしてみた。ついでに、doctypeも生成するようにしている。
予定表示と編集の分離
さてあとひとつ、予定の表示にtextareaを使わないようにしてみよう。 cmd-show-planは予定をpreタグで表示するだけにする。
(define (cmd-show-plan y m d)
(let1 plan (dbm-get (db) (db-key y m d) "")
(page
(calendar (make-month m y))
(html:p #`",|y|年,|m|月,|d|日の予定")
(html:pre (html-escape-string plan))
(html:a :href #`"?y=,|y|&m=,|m|&d=,|d|&c=e" "[予定を編集]"))))
で、「予定を編集」リンクがクリックされたら、textareaで表示。 前回までと違って、 c=e で編集ウィンドウにしたから、コミットは c=c で やることにしよう。
(define (cmd-edit-plan y m d)
(let1 plan (dbm-get (db) (db-key y m d) "")
(page
(html:form
(html:p #`",|y|年,|m|月,|d|日の予定")
(html:input :type "hidden" :name "c" :value "c")
(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 "変更"))))))
これで、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"))))
(with-db (db *db-name*)
(if (and y m d)
(cond
((equal? cmd "e")
(cmd-edit-plan y m d))
((equal? cmd "c")
(cmd-change-plan y m d plan))
(else
(cmd-show-plan y m d)))
(cmd-show-calendar y m))
)))))
予定の消去
一度でも予定を入れちゃうと、カレンダーに色がついて、このままでは それを消すことができない。間違って予定を入れちゃったらちょっと不便。 そこでついでに、予定を消せるようにもしとく。 予定の編集画面で、全部テキストを消してコミットしたらdbから消すことにする。
(define (cmd-change-plan y m d plan)
(if (and plan (not (string=? plan "")))
(dbm-put! (db) (db-key y m d) plan)
(dbm-delete! (db) (db-key y m d)))
(cgi-header :status "302 Moved"
:location #`"?y=,|y|&m=,|m|&d=,|d|"))
まとめ
ここまでまとめるとこんな感じ。
#!/usr/bin/env gosh
(use srfi-1)
(use srfi-19)
(use util.list)
(use text.html-lite)
(use gauche.sequence)
(use gauche.charconv)
(use gauche.parameter)
(use dbm.gdbm)
(use www.cgi)
(define *db-name* "/home/shiro/data/cal.data")
(define *style* "
span.planned {
background-color : #ffcccc;
}
")
;;;
;;; 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))
;;;
;;; DB
;;;
(define db (make-parameter #f))
(define-syntax with-db
(syntax-rules ()
((with-db (db path) . body)
(parameterize ((db (dbm-open <gdbm> :path path :rw-mode :write)))
(with-error-handler (lambda (e) (dbm-close (db)) (raise e))
(lambda ()
(begin0
(begin . body)
(dbm-close (db)))))))))
(define (db-key y m d) #`",|y|-,|m|-,|d|")
;;;
;;; 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|"
(if (dbm-exists? (db) (db-key year month date))
(html:span :class "planned" 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-doctype :type :xhtml-1.0-transitional)
,(html:html
(html:head (html:title "簡易スケジュール表")
(html:style :type "text/css" *style*))
(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)
(let1 plan (dbm-get (db) (db-key y m d) "")
(page
(calendar (make-month m y))
(html:p #`",|y|年,|m|月,|d|日の予定")
(html:pre (html-escape-string plan))
(html:a :href #`"?y=,|y|&m=,|m|&d=,|d|&c=e" "[予定を編集]"))))
(define (cmd-edit-plan y m d)
(let1 plan (dbm-get (db) (db-key y m d) "")
(page
(html:form
(html:p #`",|y|年,|m|月,|d|日の予定")
(html:input :type "hidden" :name "c" :value "c")
(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)
(if (and plan (not (string=? plan "")))
(dbm-put! (db) (db-key y m d) plan)
(dbm-delete! (db) (db-key y m d)))
(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"))))
(with-db (db *db-name*)
(if (and y m d)
(cond
((equal? cmd "e")
(cmd-edit-plan y m d))
((equal? cmd "c")
(cmd-change-plan y m d plan))
(else
(cmd-show-plan y m d)))
(cmd-show-calendar y m))
)))))
;; Local variables:
;; mode: scheme
;; end:
議論、コメント
勉強になります
cut-sea:(2004/08/28 23:03:03 PDT)いくつも勉強になる点がありました。 自分で一度作ってみたおかげで細部まで何やってるかだいたい分かりました。
こんなに便利かつエレガントになると思わなかった点
- 文字列の map
- 文字列への埋め込み #`"ほげほげ,|var|ほげりん,|var2|"
- めちゃめちゃへぼいですが、(<= 1 m 12) って使い方、そりゃそうかと。(恥)
多分普段から私の書くコードのネストが多くなっている理由はこの辺かと。
まるで知らなかった点
- html:input の hidden てこうやって使うのか
- cgi-get-parameter ってこうやって使うのか
- スタイルシートがこんな風に埋め込めちゃうのか
- parameter ってこうやって使うのか
- db アクセス関係もこうやるのか(dbm-getとか)
- 相対パスって "?var=val..." だけでも良かったのか
よく分かってない点(少し解説頂けるとうれしい)
- ブラウザ側でリロードした時のために cgi-header に :status "302 Moved" を
返しているところ。(ブラウザや http の動作が分かってないんですかね)
- cgi-header :status "302 Moved" :location "hoge" とやると、ブラウザ側で "hoge"を改めてGETに行ってくれます。その状態でブラウザがreloadすると、 "hoge"がフェッチされます。それはGETリクエストなので、再POSTにはなりません。
- ces-convert をかますところ。
plan 内の予定表に空白文字が入っていると+になっちゃうのを回避するのもこれですか?
実は自分でコード書いている時はhtml-escape-stringだと思ってたんだけど、
これは変換してみたら違いますもんね。
- ces-convertは関係ないです。というかcut-seaさんのところで出てる問題が よくわからない。html-escape-stringして返してれば、cgiに渡ってきた時に ちゃんと復元されてるはずだけど。
- 私のコードでは textarea に "LL Weekend 初日" とか書くと
"LL+Weekend+初日"と表示。DB内にも+が埋まってしまいます。
(html:textarea :rows 10 :cols 40 :name ymd :wrap "virtual" (let ((dbfile (dbname *mydbpath* now-cal))) (if (and (file-exists? dbfile) (assoc ymd (get-db-contents dbfile))) (html-escape-string (cdr (assoc ymd (get-db-contents dbfile)))) "")))こんな風に html-escape-string を入れても結果は同じで "LL+Weekend+初日" となるので html-escape-string を入れる場所はここじゃないのかと思ってたのですが、 Shiroさんのコードではこの部分ですよね。 で、ShiroさんのCGIを使うと+に置き換わったりしないので、なんでだろうと。 - teranishi: query->alist内のuri-decode-stringの呼び出しに":cgi-decode #t"がついていないのが原因でしょう。GaucheRefj:uri-decode-string参照
- その通りでした。調べたらブラウザから来た生の(標準入力から読み込んだ) データに+がついてたので、やっぱりCGIがブラウザから受け取ったときのデコードに 問題があったということですね。ありがとうございます。cut-sea
- なぜか私が書いたら (if hoge hogeを使った処理 "") ってのが多くて気になってた。
write-tree すると (if hoge hogeを使った処理) だけにすると hoge が無いときに
どうしても tree に #<undef> が含まれることでエラーが出ちゃうからだ。
それがdate-cell以外まるで見当たらないのが不思議。どこに消えちゃったのだろう。
というかif文をhtmlの中に入れてないのがいいのかな。
- hira: write-treeは'()を表示しないので、mapに与えたリストが空なら何も表示されないということと、,@で'()が溶けて消えてしまうことらへんが関係あるのかな・・・とおもってソースを読んでみたんですけど、あまり関係なさそうですね。このへんの問題はScheme:マクロの効用の「リストの構築」が参考になるかもしれません。
- hira: あと、write-treeで何も書きたくないときは""より'()のほうが速いですよきっと。
- 私の作ったのが条件に応じてページの"部分"を埋め込むかどうかを やっているのに対して、条件に応じてどのページを出力するかを上位で決めて、 必要なパーツを出力する様にしているために "" とかがないんですね。 すべては構成の仕方で差がついているみたい。cut-sea:2004/08/30 15:04:38 PDT
- cgi-get-parameter でアクセスしているのは POST リクエストで標準入力から読み込んで得られるパラメータですよね？QUERY_STRINGの中身ではないですよね？
- ちゃいます。cgi-mainが、REQUEST_METHODがGETの場合はQUERY_STRINGを、 POSTの場合は標準出力を使う、という処理をしてくれるので、POSTで来ても GETで来ても同じコードで対応できます。
- uri-encode/decode って一切気を配らなくていいんですね。
これって cgi-main を使ってるからかな。
- いいえ。uri-encodeは自前でやらないとだめです。このスクリプトでuri-encode が無いのは、単にencodeを必要とするuriを生成していないだけです。 なお、uri-decodeはcgi-mainがやってくれます。
- RFC2396 の 2.4.2 に書いてあるのが考え方ですかね。
A URI is always in an "escaped" form, since escaping or unescaping a completed URI might change its semantics. Normally, the only time escape encodings can safely be made is when the URI is being created from its component parts; each component may have its own set of characters that are reserved, so only the mechanism responsible for generating or interpreting that component can determine whether or not escaping a character will change its semantics. Likewise, a URI must be separated into its components before the escaped characters within those components can be safely decoded.
エンコーディングは結局スクリプトを組む人間が責任を持ってやるしかなくて、 どれがそうかは把握できないので汎用的に対応することは出来ない。 デコードは CGI の場合は受取り方が2種類(GET/POST時)で決まっているから cgi-main で対応出来るということか。cut-sea:2004/08/30 18:03:20 PDT
- 日本の祝日をカレンダーに埋め込むスマートな方法はありますでしょうか？
- Shiro(2005/04/09 05:51:47 PDT): うーん、祝日の決め方自体がアドホックな感じなんで、 アルゴリズム一発ってわけにはいかないでしょうね。ルールベースで祝日を定義できる ライブラリ関数を作っておいて、それで祝日を定義してゆく (固定日、「何月の第何月曜日」、 「日曜と重なったら翌日代休あり」等)しかないんじゃないでしょうか。
- Gauche:カレンダー計算 とかしてみますか?cut-sea