前章ではCGIのセッション管理の問題点を解決する方法の一つとして継続渡しスタイルのWebサーバを試作しました。
Gaucheで書かれた継続渡しスタイルWebサーバーとしては、
すでに2003年からKahuaがオープンソースで公開されています。
本章ではKahuaを使ってスケジュール管理アプリケーションを書き直してみます。
CGIによるWebアプリケーションとKahuaがどう異なるのか、
実際に使って確かめてみましょう。
Kahuaとは？
Kahua(かふあ)は、Gaucheで書かれたアプリケーションフレームワークであり、
実行環境であり開発環境です。Kahuaには以下の特徴があります。
- 継続渡しスタイル(CPS)でのプログラミング
- 基本データ形式はS式
- 統合されたオブジェクトデータベース
- 動的でインクリメンタルな開発スタイル
- 汎用アプリケーションサーバ
- オープンソース
継続渡しスタイル(CPS)でのプログラミング
Kahuaでは、ある時点の状態とその後の処理とを、継続というオブジェク
トとして取り出すことができます。このため、例えばWebアプリケーションにお
いて複数のリクエスト-レスポンスサイクルにまたがる処理を記述する場
合でも、状態の保持や整合性の確保に気を使う必要はなく、単純に次のリクエ
ストで行う処理を継続として指定するだけですむのです。この、「次の
処理を指定する」プログラミングスタイルを「継続渡しスタイル(CPS)」と言い
ます。Kahuaはまさにこの継続渡しスタイルを使うことで、ロジックをよりスト
レートに記述できる環境を提供します。
基本データ形式はS式
Kahuaは、あらゆる場面で基本データ形式としてS式を採用しています。S式は
Schemeにとって最も扱いやすい表現形式であると同時に、HTMLやXMLと同等の表
現力とそれ以上の柔軟性とを兼ね備えています。S式を使うことで、手続きとデー
タとをエレガントに統合することができ、例えば動的なWebページを命令的にで
はなく宣言的に記述することができるのです。
オブジェクトデータベース
GaucheにはCLOSに似た非常に強力なオブジェクトシステムが備わっていますが、
Kahuaはそれをデータストレージにまで拡張します。指定されたオブジェクトは
自動的に永続化されてデータベースストレージに保存されます。また、永続ク
ラスの定義が変更されると、保存されているオブジェクトは自動的にその変更
に追随して更新されます。開発者はオブジェクトの保存に気をとられることな
く、ロジックに集中することができます。データベースストレージとしてはファ
イルシステムの他、MySQLやPostgreSQLを使うこともできます。
動的でインクリメンタルな開発
動作中のKahuaアプリケーションサーバ(ワーカと呼びます)に直接接続し、任意
のScheme式を評価することができます。これにより、ワーカを止めることなく
動的かつインクリメンタルに開発を進めることができます。
汎用アプリケーションサーバ
KahuaはWebアプリケーションを記述するのに極めて強力な機能をたくさん備え
ていますが、Webアプリケーションしか開発できないわけではありません。
Kahuaプロトコルを扱えるリッチクライアントを開発してフロントエンドとする
ことももちろん可能です。
オープンソース
KahuaはGaucheと同じ修正BSDライセンスの下オープンソースソフトウェアとし
て公開されています。その一部は独立行政法人情報処理推進機構の平成15年度
オープンソフトウエア活用基盤整備事業の委託事業として開発され、その後
Kahuaプロジェクトが開発を続けています。Kahuaの開発にはどなたでも参加す
ることができます。
※「Kahua」とはハワイ語で、
基盤、基礎、土台、広場(集会場)、何かを産み出す母体
という意味です。
Kahuaを準備する
インストール
Kahuaの詳しいインストール手順については、付録に掲載してありますので参照
してください。ここでは手順を簡単に紹介するにとどめます。
$ tar xzf Kahua-1.0.7.1.tgz
$ cd Kahua-1.0.7.1
$ ./configure --prefix=/usr/local/kahua
$ make
$ make check
$ sudo make install
これで、/usr/local/kahuaの下にKahuaがインストールされます。Kahuaに含ま
れる各コマンドを呼び出しやすくするために、PATHに/usr/local/kahua/binを
追加しておいてください。これ以降の説明では、PATHに/usr/local/kahua/bin
が含まれているものとします。
さらに、Kahuaソースツリー内のemacs/kahua.elをEmacsのロードパスに置いて
おきましょう。もちろんこの作業は、Kahuaアプリケーションの開発にEmacsを
使わないのであれば必要ありません。
Kahua開発でEmacsを使うための設定については「[[book-node/programming-gauche/197740//付録C. Kahuaインストール]]」で詳しく説明しています。
サイトバンドルの作成
Kahuaでは、ひとつのサイトを構成するアプリケーションコードやテンプレート
ファイル、データベースを、サイトバンドルというディレクトリ構
造の下に収めて管理することができます。ここでは、作成するカレンダーアプ
リケーションを動かすためのサイトとして、$HOME/workというディレクトリの
下に、siteという名前のサイトバンドルを作成することにします。
$ kahua-package create $HOME/work/site
Kahuaを起動する
開発用に自分の実行権限で、先ほど作成したサイトバンドルに対してKahuaを起
動しましょう。
$ (kahua-spvr -S $HOME/work/site -H 8088 >/dev/null 2>&1 &)
サイトバンドル $HOME/work/siteに対して、組み込みhttpdつきでKahuaサーバ
群を起動しています。Kahuaは自らバックグラウンドに移行する機能をもたない
ので、shの機能を使ってバックグラウンド実行しています。
cshシェル環境では以下の通りです。
% ( kahua-spvr -S $HOME/work/site -H 8088 > & /dev/null & )
試すだけなら、
$ kahua-spvr -S $HOME/work/site -H 8088
として、端末ひとつを使ってしまう方が単純でよいかもしれません。
アプリケーションの雛形を生成する
Kahuaアプリケーションの開発は、まずその雛形を生成し、それに手を加えてい
く形で進めていきます。scheduleという名前で雛形を生成しましょう。
$ cd $HOME/work
$ kahua-package generate schedule
Creator Name> Someone
E-Mail Address> someone@example.jp
雛形をインストールして実行する
生成したアプリケーションの雛形は、そのままアプリケーションとしてインス
トール/実行可能です。インストールしてみましょう。
$ cd $HOME/work/schedule
$ ./DIST gen
$ ./configure --prefix=/usr/local/kahua --with-site-bundle=$HOME/work/site
$ make
$ make check
$ make install
次に、$HOME/work/site/app-serversファイルをエディタで編集し、次のよう
に変更して保存します。
;; -*-scheme-*-
;; Application Service Configuration alist.
;;
(;;Each entry follow this format:
;;(<type> :arguments (<arg> ...) :run-by-default <num>
;; :profile <path-to-profile-base>
;; :default-database-name <path-to-database>)
(schedule :arguments () :run-by-default 1)
)
Kahuaなのですから、設定ファイルももちろんS式です。
(schedule :arguments () :run-by-default 1)
というのが追加したエントリです。
さぁ、このファイルをKahuaサーバ群に再読み込みさせます。
$ kahua-admin -S $HOME/work/site
spvr>
kahua-adminのコマンドプロンプトに対してreloadコマンドを発行します。
spvr> reload
(schedule)
ブラウザで、http://localhost:8088/schedule/greetingにアクセスしてみま
しょう。表示されましたか?
Kahuaアプリケーションの構造
ここでは、先ほど生成した雛形のコードを材料に、Kahuaアプリケーションプロ
グラミングに特有の概念を説明します。
アプリケーション名、エントリとURL
Kahuaアプリケーションのプログラミングでは、クライアントがあるURLにアク
セスすることで直接呼び出せる継続手続きを定義することができます。この継
続手続きのことを「エントリ」と呼びます。
エントリは、クライアントから見るとURLを構成するパス要素です。例えば、先
ほど生成した雛形アプリケーションにアクセスした際のURLのパス要素は、次の
意味を持っています。
http://localhost:8088/schedule/greeting
<------> <------>
アプリ名 エントリ名
それでは、エントリ「greeting」の定義を見てみましょう。先ほどの例では、
$HOME/work/schedule/schedule/schedule.kahuaがソースコードになります。
define-entryによる名前つきエントリの定義
ここまでで、schedule.kahuaは次のとおりになっているはずです(コメントは取り除いてあります)。
(load "schedule/version.kahua")
(define page-template
(kahua:make-xml-template
(kahua-template-path "schedule/page.xml")))
(define-entry (version)
(kahua:xml-template->sxml
page-template
:title (title/ (@/ (id "title"))
"schedule")
:body (div/ (@/ (id "body"))
(h1/ (format "schedule: version ~a"
*schedule-version*))
(a/cont/ (@@/ (cont greeting))
"greeting"))))
(define-entry (greeting)
(kahua:xml-template->sxml
page-template
:body (div/ (@/ (id "body"))
(h1/ "Hello, Kahua!")
(a/cont/ (@@/ (cont version))
"version"))))
(initialize-main-proc greeting)
define-entry構文で始まる2つの定義があるのが分かるでしょうか?
これが、「エントリ」の定義です。
greetingの定義を例に説明しましょう。
(define-entry (greeting)
(kahua:xml-template->sxml
page-template
:body (div/ (@/ (id "body"))
(h1/ "Hello, Kahua!")
(a/cont/ (@@/ (cont version))
"version"))))
この定義は、define-entry構文の本体部分を実行する手続きを定義し、
その手続きをgreetingという名前に結びつけます。
つまり、クライアントがgreetingというパス要素を持つURLにアクセスすると、
その手続きが実行されるべくセットアップするわけです。
裏側で行われる処理はともかく、define-entryとエントリとの関係は、
defineと通常の手続きの関係にとても似ています。
define-entryの構文は次のとおりです。
(define-entry (entry-name [path1 ...][:keyword param1 ...][:mvkeyword mvparam1...][:rest rargs])
...)
もしくは
(define-entry entry-name thunk)
[]は省略可能であることを示しています。path1 ... はURLにおいてentry-name
の後ろに並ぶパス要素が割り当てられ、param1 ... にはCGIパラメータの
値が割り当てられます。rargsには、path1 ...に入らなかった残りのパス要素が
リストとして割り当てられます。mvparam1 ...はparam1 ...と似ていますが、
複数の値をもつCGIパラメータを扱えるよう、値はリストとして割り当てられます。
該当する値が無かった場合、mvparam1 ...には () (空リスト)が、それ以外の
ものには#fが割り当てられます。また、引数に定義されていないパス要素や
パラメータがリクエストに含まれている場合は無視されます。
言葉で説明してもわかりにくいので例を挙げてみましょう。
(define-entry (entry path1 path2 :keyword param1 param2 :mvkeyword param3 :rest rargs)
...)
という定義があったとき、
http://localhost:8088/app-name/entry/aaa/bbb/ccc?param1=value1¶m3=value2¶m3=value3
というURLにアクセスすると、
| path1
| "aaa"
|
| path2
| "bbb"
|
| param1
| "value1"
|
| param2
| #f
|
| param3
| ("value2" "value3")
|
| rargs
| ("ccc")
|
という具合に値が割り当てられます。
entry-lambdaと無名エントリ
さて、define-entryとdefineとが似ているという説明をしましたが、実は
lambdaに似た、entry-lambdaという無名のエントリを定義する構文もあり
ます。上記の雛形コードにはentry-lambdaは使われていませんので、後ほど
scheduleアプリケーションを実装していく過程で詳しく説明することにします。
ここではentry-lambdaの構文のみを紹介しておきましょう。
(entry-lambda ([path1 ...][:keyword param1 ...][:mvkeyword mvparam1 ...][:rest rargs])
...)
引数の意味はdefine-entryのそれと同じです。なお、define-entryとentry-lambdaとの
関係は次のとおりです。
(define-entry (entry-name arg1 ...)
...)
||
(define-entry entry-name
(entry-lambda (arg1 ...)
...))
どうですか。defineとlambdaの関係にそっくりだと思いませんか?
デフォルトエントリの登録
ところで、先ほど例に挙げたURLには、行儀よくエントリ名がパス要素として含
まれていました。もしも、このパス要素を省略したURLに対して、つまり
http://localhost:8088/schedule
にアクセスしたらどうなるのでしょうか。
それを決めるのが、schedule/schedule.kahuaの最後の行に書かれている、
(initialize-main-proc greeting)
という構文です。手続きinitialize-main-procは、渡されたエントリを、
リクエストURLにエントリ名が渡されなかった場合に起動するエントリとして登
録します。ここでは、テスト用のエントリであるgreetingを登録しています。
ですから、
http://localhost:8088/schedule
にアクセスすると、
http://localhost:8088/schedule/greeting
にアクセスした時と同じ画面が表示されるわけです。
スケジュールCGIをKahua化する(1) - 表示 -
スケジュールCGIの流用
まずは前掲のスケジュールCGIから、必要な手続き群を流用しましょう。
使うのは以下の手続きです。
(use srfi-1)
(use srfi-13)
(use srfi-19)
(use util.list)
(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))
つまり、日付の計算とカレンダーの構造を構築する手続き群ということ
です。
これをもとにカレンダーを表示してみましょう。CGIでは、text.html-lite
モジュールを使いましたが、Kahuaには「高階タグ手続き」
##(footnote "Kahuaのドキュメントでは「高階タグ関数」と書かれていますが、Schemeの言語仕様ではすべて「手続き」(procedure)とされているので本書ではすべて「高階タグ手続き」と記述します)
と呼ばれる少し毛色の変わったページ(要素)構築手続き群が備わっています。
高階タグ手続き
高階タグ手続きは、要素の中身(contents)となるものを引数として受け取り、
タグ構造を生成する手続きを返す手続きです。
これを使って、宣言的にXML/HTMLページ要素を組み立てることができます。
各手続き名は、要素名の後ろに"/"をつけたものになります。現在定義済み
の手続きは以下の通りです。
font/ tt/ i/ b/ big/ small/ em/ strong/ dfn/ code/ samp/ kbd/ var/
cite/ abbr/ acronym/ sub/ sup/ span/ bdo/ br/ body/ address/ div/
a/ area/ link/ img/ hr/ p/ h1/ h2/ h3/ h4/ h5/ h6/
pre/ q/ blockquote/ ins/ del/ dl/ dt/ dd/ ol/ ul/ li/
form/ label/ input/ select/ optgroup/ option/ textarea/ fieldset/
legend/ button/ table/ caption/ thead/ tfoot/ tbody/ colgroup/
col/ tr/ th/ td/ head/ title/ base/ meta/ style/ script/ noscript/
html/ frameset/ frame/ applet/ param/ object/ embed/ noembed/
この他にも、名前が"/"で終わる便利な手続きがいくつか提供されていて、
全て同様に組み合わせて使うことができます。
それでは、現在の日付に対応するカレンダーを表す高階タグ手続きを定義してみること
にします。Kahuaに限ったことではありませんが、
カレンダーに代表される、
ある程度複雑でまとまった構造を持つ要素については、
それをひとつの部品として扱うと、
後で融通がききやすくなります。
(define (calendar/ date)
(table/
(thead/
(tr/ (th/ "←") (th/ (@/ (colspan "5")) (date->string date "~Y年~m月")) (th/ "→")))
(tbody/
(map/ (lambda (w)
(tr/ (map/ td/ w)))
(date-slices-of-month date)))))
この手続きは、標準の高階タグ手続きと組み合わせて使えることから、
名前の後ろに"/"をつけてあります。
この定義で目を引くのはmap/でしょう。おなじみのmapと非常に
よく似た機能を持ち、第1引数の手続きを第2引数のコレクションに
適用した結果を高階タグの集合である高階タグとして返します。
従って、第1引数の手続きは高階タグを返さなくてはなりません。
また、@/ で始まるリストはそれを引数とする高階タグ手続きが返す高階タグの属
性を指定します。各要素のcarが属性名を表すシンボル、cadrは属性値で、実際
にはそれにx->stringを適用したものが使われます。ただし、#fの場合は、属性
自体を省略します。
ページテンプレート
Kahuaには、特定のXMLファイルを読み込んで、簡易なページテンプレートとし
て利用する機能があります。schedule.kahuaには、すでに次の定義
が含まれているはずです。
(define page-template
(kahua:make-xml-template
(kahua-template-path "schedule/page.xml")))
これは、サイトバンドル内のテンプレートディレクトリ(templates)の下の
schedule/page.xmlというファイルを読み込んでテンプレートを生成し、
page-templateという変数に代入しています。schedule/page.xmlは、
アプリケーションの雛形とともに生成されたものです。雛形が置かれた
ディレクトリから見て、templates/page.xml にあるのがそのファイル
になります。
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">
<head>
<title id='title'>SAMPLE</title>
</head>
<body>
<div id='body'>
<h1>Hello Kahua</h1>
</div>
</body>
</html>
このページテンプレートを
使って、カレンダーを表示するエントリを定義してみましょう。まずは
現在の日付に対応するカレンダーを表示するだけにしておきます。
(define-entry (show)
(let1 date (current-date)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日"))
:body (div/ (calendar/ date)))))
キーワード、:titleと:bodyは、それぞれテンプレートファイル内の
id属性値titleとbodyとに対応しています。つまり、キーワード引数
は、そのキーワードと同名の属性値を持つテンプレート内の要素を、
キーワード直後に置かれている高階タグで置き換えることを指定する
わけです。
さぁ、試してみましょう。現在のKahuaはソースファイルを更新しても
自動では再ロードしてくれないので、kahua-adminからupdateコマンドを発行して
scheduleアプリケーションを再ロードします。
spvr> update schedule
update: schedule(jb6:17cuw)
ブラウザで
http://localhost:8088/schedule/show
にアクセスしてみてください。カレンダーが表示されるはずです。
URLによる日付の移動
今定義されている「show」エントリは、何のCGIパラメータも解釈せず、現在の日
付を含むカレンダーを表示する機能しかありません。これにパラメータを渡し
て、任意の日付を含むカレンダーを表示させましょう。
前の章で紹介したスケジューラCGIでは、日付はCGIパラメータの形で渡していました。
それでもいいのですが、ここではあえて、パス要素
として渡してみることにしましょう。つまり、
http://localhost:8088/schedule/show/2007/4/1
というURLが、2007年4月1日を含むカレンダーを表すものとするのです。
まずは、パス要素として渡ってくる、年、月、日の組を<date>インスタンス
に変換する手続きを書きます。
(define (ymd->date y m d)
(let1 now (current-date)
(cond [y (let ((m (if m (x->integer m) 1))
(d (if d (x->integer d) 1)))
(make-date 0 0 0 0
(if (<= 1 d 31) d 1)
(if (<= 1 m 12) m 1)
(x->integer y) (date-zone-offset now)))]
[else now])))
条件分岐が入っているのは、年、月、日が渡されなかった場合の処理と、
月、日として不正な値を渡された時の処理を行うためです。この部分は、
どのくらい厳密に行うかによってやり方が違ってくるでしょう。
ここでは、Kahuaプログラミングの本筋に集中するために
- 年月日が全て省略されていたら現在の日付
- 日または月が省略されたら各々1であるとする
- 日が整数でなかったり、1〜31の範囲の外だったら1とする
- 月が整数でなかったり、1〜12の範囲の外だったら1とする
- 年が整数でなかったら、0とする
という、本当に最低限のことしかしていません。厳密にやるのは、
仕様を考えるのも含めてけっこう大変です。
これを使って「show」エントリの定義を書き直します。
(define-entry (show y m d)
(let1 date (ymd->date y m d)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日"))
:body (div/ (calendar/ date)))))
試してみましょう。任意の日付を含むカレンダーが表示できましたか?
名前つきエントリへのリンク
カレンダー内の日付や矢印といったの要素にリンクを設置して、
日付を移動させてみましょう。
高階タグ手続きには、同一アプリケーション内の名前つきエントリへのリンクを
埋め込むための手続きがいくつか含まれています。"cont/" で終わる名前を
持っている手続きがそれなのですが、ここでは「a/cont/」という手続きを
使います。
(a/cont/ (@@/ (cont entry path1 ... (param1 value1) ...))
contents)
entryはエントリとして使用できる手続き、path1 ... はパス要素と
して渡すパラメータ、(param1 value1) という構文になっているリストは、
CGIパラメータとして渡すパラメータになります。@/ ではなく、@@/ で
あることに注意してください。@/ は要素の属性を表していましたが、
@@/ は拡張属性を表しています。
それでは、これを使って、カレンダーの各セル(日付の数値が入っている
枠)を組み立てる手続き「date-cell/」を書いてみましょう。
(define (date-cell/ date day entry)
(td/ (and day (a/cont/ (@@/ (cont entry (date-year date) (date-month date) day)) day))))
エントリを引数で渡したのは、
後で他のエントリでも使うためです。
このdate-cell/ を使って、カレンダーの日付部分を書き
換えます。ついでにcalendar-body/という名前の手続きにくくり出して
しまいましょう。
(define (calendar-body/ date entry)
(define (date-cell/ date day entry)
(td/ (and day (a/cont/ (@@/ (cont entry (date-year date) (date-month date) day)) day))))
(tbody/
(map/ (lambda (w)
(tr/ (map/ (cut date-cell/ date <> entry) w)))
(date-slices-of-month date))))
さらに、カレンダーのヘッダ部分を定義します。←には前月1日へのリンクを、→には
翌月1日へのリンクを設置します。ここまでは前に紹介したスケジューラCGIと同じですが、
さらに、月を表す真ん中の文字列(yyyy年m月)を本日へのリンクにしてみました。
(define (calendar-head/ date entry)
(define (month/cont/ date entry content)
(a/cont/ (@@/ (cont entry (date-year date) (date-month date) 1)) content))
(define (today/cont/ entry content)
(let1 today (current-date)
(a/cont/ (@@/ (cont entry (date-year today) (date-month today) (date-day today)))
content)))
(thead/
(tr/ (th/ (month/cont/ (prev-month date) entry "←"))
(th/ (@/ (colspan "5"))
(today/cont/ entry (date->string date "~Y年~m月")))
(th/ (month/cont/ (next-month date) entry "→")))))
ちょっと複雑に見えますが、やっていることは前に挙げたdate-cell/と同じです。
前月や翌月、本日の日付を計算しているだけです。これで、手続きcalendar/は
非常に単純になります。
(define (calendar/ date entry)
(table/
(calendar-head/ date entry)
(calendar-body/ date entry)))
calendar/の引数が変ったのでshowも変更しておきます。
(define-entry (show y m d)
(let1 date (ymd->date y m d)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日"))
:body (div/
(calendar/ date show)))))
最後に、initialize-main-procの引数を「greeting」エントリから
「show」エントリに変更してみます。
(initialize-main-proc show)
「greeting」エントリはもう不要です。消してしまってかまいません。
これで http://localhost:8088/schedule/show/2007/4/1にアクセスすると日付にリンクが出現します。
まだ日付リンクをクリックしても「show」エントリを表示していますが、
次はいよいよスケジュールを登録できるようにしますよ。
スケジュールCGIをKahua化する(2) - 編集と保存 -
ここでは、
日付ごとに自由な書式でスケジュールを登録、保存させてみましょう。
Kahuaオブジェクトデータベースと永続クラス
データを保存するための準備です。スケジュールCGIでは
dbmモジュールを明示的に使用しました。Kahuaには、
組み込みのオブジェクトデータベースがあるので、それを
使うことにします。
Kahuaのオブジェクトデータベースを使うには、
「<kahua-persistent-base>」というクラスを継承した
クラスを定義します。このクラスを永続クラスと
呼んでいます。スケジュールデータとしては、
- 日付
- スケジュールの内容
という項目を保存できればいいでしょう。クラス定義は次のとおりです。
(define-class <schedule> (<kahua-persistent-base>)
((date :init-keyword :date :allocation :persistent :index :unique)
(memo :init-keyword :memo :allocation :persistent)))
dateスロットには日付を文字列化したもの(どうやって文字列化するかは
あとで触れます)、memoスロットには自由書式のスケジュールを保持します。
クラスの定義をよく見てみると、通常のクラス定義では見かけないスロットオ
プションがつけられいます。各々のスロットオプションの意味は次の通りです。
| :allocation
| :persistentを指定すると、このスロットの値がデータベースに保存されます。
|
| :index
| インスタンスの検索に使用するスロットの定義に、:uniqueもしくは:anyを指定します。:uniqueを指定するとそのスロットに同じ値を持つインスタンスは1つしか存在できません。:anyは同じ値を持つインスタンスが複数存在できます。
|
次に、日付を表す<date>のインスタンスをdateスロットに設定するための
文字列に変換する手続きを定義します。
(define (date->dbkey date . maybe-day)
(let1 day (get-optional maybe-day (date-day date))
(format "~d-~2,'0d-~2,'0d" (date-year date) (date-month date) day)))
省略可能引数で日を指定している理由は後ほど説明します。
さて、ついでにスケジュールを保存するための手続きを定義してみましょう。
(define (schedule-commit sch date memo)
(cond [sch (if (or (not memo) (string-null? memo))
(remove-kahua-instance sch)
(set! (ref sch 'memo) memo))]
[else (make <schedule>
:date (date->dbkey date)
:memo memo)]))
remove-kahua-instanceは、渡された永続オブジェクトを論理削除する
手続きです。つまり、memo欄を空にして保存すると、そのスケジュールは
削除されるということです。
これを起動するHTMLフォームを定義します。
(define (schedule-edit/ date)
(let ((y (date-year date))
(m (date-month date))
(d (date-day date))
(sch (find-kahua-instance <schedule> 'date (date->dbkey date))))
(node-set/
(p/ (format "~d年~d月~d日" y m d) "の予定を編集 "
(a/cont/ (@@/ (cont show y m d)) "[戻る]"))
(form/cont/ (@@/ (cont (entry-lambda (:keyword memo)
(schedule-commit sch date memo)
(redirect/cont (cont show y m d)))))
(textarea/ (@/ (name "memo")) (and sch (ref sch 'memo)))
(input/ (@/ (value "保存") (type "submit")))))))
手続きschedule-commitと併せて読むと、
手続きschedule-edit/が何をやっているのかが理解できるでしょう。
find-kahua-instanceは、ある条件を満たす永続オブジェクトを見つけ出す手続きです。
ここでは、dateというスロットにある値を持っているオブジェクトを探しています。
また、form/cont/はa/cont/同様、リクエストを送るURLをエントリから
組み立ててform要素のaction属性の値として使用し、form要素を組み立てます。
ここでは、entry-lambdaを使って無名エントリを作って渡しています。
「:keyword memo」は、CGIパラメータとしてmemoを取ることを示しています。
node-set/は複数の高階タグ手続きをまとめてひとつの高階タグ手続きに見せかける
ための手続きで、これ自体はタグを生成しません。
手続きschedule-commitに渡されるschやdateは、自由変数として渡っています。
自由変数とは式の外を参照している変数のことです。
手続きの中から外の環境を参照している変数や、
トップレベルを参照している変数は自由変数です。
つまり、わざわざパラメータやセッションオブジェクトといった大域変数を
明示的に経由して渡す必要がないのです。
これまで見たとおり、
form/cont/やa/cont/にわたすエントリとして、
無名エントリを無名手続きと同様なやり方で使用し、
処理の最後で適切なエントリ(ここでは同じ日を
表示するshowエントリ)にリダイレクトするという手法は、Kahuaアプリケーション
では半ばイディオム(慣用句)となっています。
それでは、このフォームを含めて、編集画面を表示する「edit」エントリを
定義しましょう。
(define-entry (edit y m d)
(let1 date (ymd->date y m d)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日 [編集中]"))
:body (div/
(calendar/ date edit)
(schedule-edit/ date)))))
前に定義した手続きcalendar/がそのまま使えています。つまり、編集画面に
移ってから、編集すべき日付を自由に移動することができるわけです。
calendar/にエントリを渡しておいたのはこのためだったのです。
最後に、エントリ「show」でもその日の予定を表示させしておきましょう。
予定を表示するための手続きschelude-show/を定義し、それをエントリshow
に組み込みます。
(define (schedule-show/ date)
(let ((y (date-year date))
(m (date-month date))
(d (date-day date))
(sch (find-kahua-instance <schedule> 'date (date->dbkey date))))
(node-set/
(p/ (format "~d年~d月~d日の予定 " y m d)
(a/cont/ (@@/ (cont edit y m d)) "[編集]"))
(and sch (pre/ (ref sch 'memo))))))
;; schelude-show/を組み込んだ
(define-entry (show y m d)
(let1 date (ymd->date y m d)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日"))
:body (div/
(calendar/ date show)
(schedule-show/ date)))))
インストールしてリロードしてみましょう。編集画面と表示画面を自由に行き来でき、
スケジュールを保存できますか?
スケジュールCGIをKahua化する(3) - 全景 -
最後に、完成したスケジュールアプリケーションの全てのコードを載せておきます。
このくらいの規模のアプリケーションだと、コード量においては
CGIとあまり差が出ませんが、
リンクによるナビゲーションの書きやすさといった、
Kahuaの特徴の一端に触れることができたのではないでしょうか。
(load "schedule/version.kahua")
(use srfi-1)
(use srfi-13)
(use srfi-19)
(use util.list)
(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 page-template
(kahua:make-xml-template
(kahua-template-path "schedule/page.xml")))
(define (calendar-head/ date entry)
(define (month/cont/ date entry content)
(a/cont/ (@@/ (cont entry (date-year date) (date-month date) 1)) content))
(define (today/cont/ entry content)
(let1 today (current-date)
(a/cont/ (@@/ (cont entry (date-year today) (date-month today) (date-day today)))
content)))
(thead/
(tr/ (th/ (month/cont/ (prev-month date) entry "←"))
(th/ (@/ (colspan "5"))
(today/cont/ entry (date->string date "~Y年~m月")))
(th/ (month/cont/ (next-month date) entry "→")))))
(define (calendar-body/ date entry)
(define (planned? date day)
(and day (find-kahua-instance <schedule> 'date (date->dbkey date day)) "planned"))
(define (date-cell/ date day entry)
(td/ (@/ (class (planned? date day)))
(and day (a/cont/ (@@/ (cont entry (date-year date) (date-month date) day)) day))))
(tbody/ (@/ (class "calendar-body"))
(map/ (lambda (w)
(tr/ (map/ (cut date-cell/ date <> entry) w)))
(date-slices-of-month date))))
(define (calendar/ date entry)
(table/
(calendar-head/ date entry)
(calendar-body/ date entry)))
(define (ymd->date y m d)
(let1 now (current-date)
(cond [y (let ((m (if m (x->integer m) 1))
(d (if d (x->integer d) 1)))
(make-date 0 0 0 0
(if (<= 1 d 31) d 1)
(if (<= 1 m 12) m 1)
(x->integer y) (date-zone-offset now)))]
[else now])))
(define-entry (show y m d)
(let1 date (ymd->date y m d)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日"))
:body (div/
(calendar/ date show)
(schedule-show/ date)))))
(define-entry (edit y m d)
(let1 date (ymd->date y m d)
(kahua:xml-template->sxml
page-template
:title (title/ (date->string date "~Y年~m月~d日 [編集中]"))
:body (div/
(calendar/ date edit)
(schedule-edit/ date)))))
(define-class <schedule> (<kahua-persistent-base>)
((date :init-keyword :date :allocation :persistent :index :unique)
(memo :init-keyword :memo :allocation :persistent)))
(define (date->dbkey date . maybe-day)
(let1 day (get-optional maybe-day (date-day date))
(format "~d-~2,'0d-~2,'0d" (date-year date) (date-month date) day)))
(define (schedule-commit sch date memo)
(cond [sch (if (or (not memo) (string-null? memo))
(remove-kahua-instance sch)
(set! (ref sch 'memo) memo))]
[else (make <schedule>
:date (date->dbkey date)
:memo memo)]))
(define (schedule-edit/ date)
(let ((y (date-year date))
(m (date-month date))
(d (date-day date))
(sch (find-kahua-instance <schedule> 'date (date->dbkey date))))
(node-set/
(p/ (format "~d年~d月~d日" y m d) "の予定を編集 "
(a/cont/ (@@/ (cont show y m d)) "[戻る]"))
(form/cont/ (@@/ (cont (entry-lambda (:keyword memo)
(schedule-commit sch date memo)
(redirect/cont (cont show y m d)))))
(textarea/ (@/ (name "memo")) (and sch (ref sch 'memo)))
(input/ (@/ (value "保存") (type "submit")))))))
(define (schedule-show/ date)
(let ((y (date-year date))
(m (date-month date))
(d (date-day date))
(sch (find-kahua-instance <schedule> 'date (date->dbkey date))))
(node-set/
(p/ (format "~d年~d月~d日の予定 " y m d)
(a/cont/ (@@/ (cont edit y m d)) "[編集]"))
(and sch (pre/ (ref sch 'memo))))))
(initialize-main-proc show)
by び
