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

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&amp;m=7">←</a
></td
><td colspan="5" align="center">2004/8</td
><td><a href="?y=2004&amp;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:
More ...