本題
これまでのような、コンソールライクなWebプログラミングだと、dispatchパターンが頻出します。こんなん。
(let ((req (cgi-get-parameter "value" (show (html:html ...))))) (case req ...
で、
に、send/suspend/dispatchという話があって、WebプログラミングはコンソールというよりはGUIなのだから、それに応じて、リンクごとに継続を仕込めるほうが便利じゃね、そうすればクエリパラメータから値を取り出してうんぬんなんて低レベルなことを意識せずにすむよ、と。
論文のほうは、それを escape continuation を使ってより軽量にやるらしいんですが、そこはちょっとわかりませんでした。なので単純に、いつも使っている継続テーブルに保存してます。
- 使いかた
- show でページ出力&ユーザの入力を待つ。(他では、send/suspend (論文)とか、sendPageAndWait(Cocoon)と呼ばれている)
- action で継続を仕込む
以前のsum.fcgiはこうなります。
(define (main args) (contcgi-main (lambda (params) (let* ((a (show (html:html (html:body (html:p "? + ? = ?") (html:p "input number") (html:form :method "GET" :action "./sum.fcgi" (html:input :type "text" :name "value") (html:input :type "submit") (html:input :type "hidden" :name "kurl" :value (action (lambda (params) (cgi-get-parameter "value" params :default #f :convert x->number))))))))) (b (show (html:html (html:body (html:p a " + ? = ?") (html:p "input number") (html:form :method "GET" :action "./sum.fcgi" (html:input :type "text" :name "value") (html:input :type "submit") (html:input :type "hidden" :name "kurl" :value (action (lambda (params) (cgi-get-parameter "value" params :default #f :convert x->number)))))))))) (show (html:html (html:body (html:p a " + " b " = " (+ a b)))))))))
action 関数で、コールバックをリンクに埋め込みます。HTMLに入るのは継続のid(整数)だけです。内容はサーバの継続テーブルの中に記憶。
いわゆる局所的なCPSです。なんなら全部CPSで書けます。
(define (main args) (contcgi-main (lambda (params) (show (html:html (html:body (html:p "? + ? = ?") (html:p "input number") (html:form :method "GET" :action "./sum2.fcgi" (html:input :type "text" :name "value") (html:input :type "submit") (html:input :type "hidden" :name "kurl" :value (action (lambda (params) (let ((a (cgi-get-parameter "value" params :default #f :convert x->number))) (show (html:html (html:body (html:p a " + ? = ?") (html:p "input number") (html:form :method "GET" :action "./sum2.fcgi" (html:input :type "text" :name "value") (html:input :type "submit") (html:input :type "hidden" :name "kurl" :value (action (lambda (params) (let ((b (cgi-get-parameter "value" params :default #f :convert x->number))) (show (html:html (html:body (html:p a " + " b " = " (+ a b))))))))))))))))))))))))
↓counter.fcgiは前よりきれいに書けるようです。sumは元来がコンソールライクで、counterはGUIライクだからでしょうか。
(define (main args) (contcgi-main (lambda (params) (let loop ((counter 0)) (show (html:html (html:body (html:h1 counter) (html:br) (html:a :href (format #f "./counter.fcgi?kurl=~a" (action (lambda _ (loop (+ counter 1))))) "++") " " (html:a :href (format #f "./counter.fcgi?kurl=~a" (action (lambda _ (loop (- counter 1))))) "--"))))))))
(define-module www.contcgi2 (use text.tree) (use text.html-lite) (use file.util) (use www.cgi) (use www.fastcgi) (export show action contcgi-main)) (select-module www.contcgi2) ;;Kimura Fuyuki氏の、Gauche-fastcgiのコードが参考になりました。 ;;ありがとうございます。 ;;www.fastcgiモジュールでexportされていない関数で、必要なものがあるから、取り出す。 (define fcgx-is-cgi (with-module www.fastcgi fcgx-is-cgi)) ;継続サーバの肝である継続を保存するハッシュテーブル。 (define cont-table (make-hash-table 'eq?)) ;;継続を保存するたびにインクリメントすることで、一意なidを継続に割り当てる。 (define kurl 0) ;;大域脱出用。 (define return #f) ;;file-mtimeでスクリプトの更新を検知する。検知したら、エラーページを表示しつつ、fastcgiプロセスを再起動するようにしてある。 (define script-modified? #f) (define (make-modified? path) (let1 initial-mtime (file-mtime path) (lambda () (not (file-mtime=? path initial-mtime))))) ;;cont-tableハッシュテーブルに見つからないkeyが、CGIパラメータkurlで指定された場合の、エラーページ (define (error-page params) `(,(cgi-header) ,(html-doctype) ,(html:html (html:head (html:title "error")) (html:body (html:p "You gave an invalid value on 'kurl'.") (html:p "Please restart the script from " (html:a :href (cgi-get-metavariable "SCRIPT_NAME") "here")) (html:p (html:b "pid = " (sys-getpid))) ;;CGIにあたえられたパラメータをhtml:tableの一覧にして表示。 (html:table :border 1 (html:tr (html:th "Name") (html:th "Value")) (map (lambda (p) (html:tr (html:td (html-escape-string (car p))) (html:td (html-escape-string (x->string (cdr p)))))) params)))))) ;;一時的にactionをこのリストにためておく。showで使ったあと、また空リストにset!することになっている。 (define actions-list '()) ;;actions-listにCPSなprocを追加するとともに、その継続への一意なidを返す。 (define (action proc) (begin0 (+ kurl (length actions-list)) (set! actions-list (cons proc actions-list)))) (define (show tree) (call/cc (lambda (cc) (for-each (lambda (p) (hash-table-put! cont-table kurl (lambda (params) (cc (p params)))) (inc! kurl)) (reverse actions-list)) (set! actions-list '()) (return `(,(cgi-header) ,(html-doctype) ,tree))))) (define (contcgi-main proc) (define (body params) (let ((key (cgi-get-parameter "kurl" params :default #f :convert x->number))) (call/cc (lambda (cc) (set! return cc) (cond ((script-modified?) (error "Maybe you modified the script file")) ;;foo.fcgi?kurl=1などなら、継続を呼び出す。 (key ((hash-table-get cont-table key error-page) params)) ;;foo.fcgiなら、メインロジックであるprocを呼び出す。 (else (proc params))))))) (define (debug-loop) (cgi-main body) (debug-loop)) (set! script-modified? (make-modified? (with-module user *program-name*))) ;;端末からの実行なら、インタラクティブなデバッグに入る。 (when (fcgx-is-cgi) (set-signal-handler! SIGINT (lambda (n) (display "Received SIGINT\n" (current-error-port)) (exit 1))) (debug-loop)) (with-fastcgi (lambda () (cgi-main body :on-error (cut raise))))) (provide "www/contcgi2")
