2007/08/08

[Common Lisp][UCW] フォームの値取得と入力チェック

UCW でフォームからの値取得と入力チェックを行ってみます。

top-window コンポーネントに name スロットを定義します。
name スロットは string-field のインスタンスに初期化します。
その string-field インスタンス生成時に :validators によって必須チェックをしこみます。

入力チェックは top-window-submit アクションの中で行います。
validp メソッドによりコンポーネントのスロットに :validators で指定してあったチェック処理が実行されます。
validp は (values エラーの有無 ((スロット1 . validator1) (スロット2 . validator2))) のような多値を返します。ここからエラーの有無を判定し、エラーメッセージを取得します。
エラーがなければ、top-window の name から value メソッドで入力された値を取得し、next-page を call するときの引数にそれを渡して画面遷移します。
エラーがあれば top-window の message にエラーメッセージを設定します。

バリデーションのあたりはまだ洗練されていな感じです。
他に何かよい方法があるのでしょうか?


;; ucw がロードされていなければロードする。
(eval-when (:load-toplevel :compile-toplevel :execute)
(unless (find-package :ucw)
;; UCW の start.lisp をロードする。パスは環境にあわせて修正してください。
(load "/home/ancient/letter/lisp/ucw/ucw-boxset/start.lisp")))

(in-package :it.bese.ucw-user)

(defvar *hello-form-application*
(make-instance 'cookie-session-application
:url-prefix "/hello-form/" ; / で終ること
:debug-on-error t) ; エラー時にはデバッガを起動
"アプリケーションの作成。")

;; アプリケーションをサーバに登録する。
(register-application *default-server* *hello-form-application*)

;; エントリポイントの作成。http://localhost:8080/hello-form/index.ucw
(defentry-point "index.ucw" (:application *hello-form-application*)
()
;; トップページの無限ループ
(loop (call 'top-window)))

(defcomponent top-window (simple-window-component)
((name
:accessor name
:initform (make-instance
'string-field
:validators `(,(make-instance 'not-empty-validator
:message "名前を入力してください。")))
:documentation "必須入力チェックを行なう。")
(messages :initform nil :accessor messages
:documentation "入力エラー時のメッセージを保持するために"))
(:default-initargs :title "トップページ")
(:documentation "最初のページです。入力フォームがあります。"))

(defmethod render ((self top-window))
"入力フォームを表示します。"
;; エラーメッセージの表示
(when (messages self)
(<:ul (dolist (message (messages self))
(<:li (<:b (<:as-html message))))))
;; フォームの表示
(<ucw:form :action (top-window-submit self)
(<:div "名前" (render (name self))
(<:submit))))

(defaction top-window-submit ((self top-window))
"入力チェックを行い、次のページに遷移します。"
(setf (messages self) nil)
(multiple-value-bind (validp faileds) (validp self)
(if validp
(call 'next-page :name (value (name self)))
(setf (messages self)
(mapcar #'(lambda (arg)
(ucw::message (cdr arg)))
faileds)))))

(defcomponent next-page (simple-window-component)
((name :initarg :name :accessor name))
(:default-initargs :title "次のページです")
(:documentation "前のページの入力を表示するためのページです。"))

(defmethod render ((self next-page))
"前のページで入力した name を表示します。"
(<:p (<:as-html (name self)))
(<ucw:a :action (ok self) "最初のページに戻る"))

0 件のコメント: