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

パラメータの受け取り

では、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: