Gauche:CGI:スケジュール予定表:Shiro版:ver1
何はともあれカレンダー
まずは、カレンダー機能を実現してみましょうか。
カレンダーの基本関数
カレンダーを作るのに必要なのは、与えられた月の最初の日の曜日とその月の 日数を知ることだ。基本的な材料(閏年の公式、曜日を求める公式など) から組み立ててもいいのだが、めんどくさい。せっかく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: