Common Lisp と AllegroServe(Aserve) で作る Web アプリケーション

Common Lisp で書かれた Web サーバである AllegroServe(Aserve) を使って Web アプリケーションを作ってみたいと思います。

はじめに

Java の Servlet が Java VM の中で高速で動作するように、 Aserve とその CGI も Lisp 中で高速に動作します。
頻繁に更新される傾向にあるWebサイトには、 Lisp の動的な性格はとても適しています。サービスをとめることなく、Webサーバや CGI が稼働したまま、変更を行うことができます。

環境

Linux(Debian unstable)
CMUCL(Common Lisp)
AllegroServe(Web サーバ)
PostgreSQL(DB)
UncommonSQL(Lisp と PostgreSQL のミドル)

Debian の unstable で /etc/apt/sources.list に
deb http://www-jcsu.jesus.cam.ac.uk/ftp/pub/debian local lisp
deb-src http://www-jcsu.jesus.cam.ac.uk/ftp/pub/debian local lisp
を加えれば、すべてパッケージとしてインストールできます。

Hello World!

まずは、Aserve で Hello World! と表示するページを作成するところまで行ってみます。
現在の Aserve(cl-aserve) のパッケージには不具合がありので、まずそれを修正しましょう。
/usr/share/common-lisp/source/acl-compat/acl-socket-cmu.lisp の141行目(関数local-host)の sys:fd-stream-fd を fd に書きかえます。
root になって CMUCL を起動し(lisp コマンド)、 (mk:compile-system :aserve) を実行します。
以上で修正作業は終りです。 (でも、本当にこの修正でいいのかな?)
それでは、Aserve を起動してみましょう。

(require :aserve)
(init-aserve-cmu)  ; CMUCL使用時のみ
(net.aserve:start :port 8888)

でポート8888で Aserve が起動しました。
次に Hello World! のページを作ります。

(net.aserve:publish
 :path "/"
 :content-type "text/html; charset=euc-jp"
 :function
 #'(lambda (req ent)
     (net.aserve:with-http-response
      (req ent)
      (net.aserve:with-http-body
       (req ent)
       (net.html.generator:html
	(:html
	 (:head (:title "Hello World!"))
	 (:body "Hello World!"
	 :br "こんにちは!")))))))

ブラウザで http://localhost:8888/ を開いてください。すべてがうまくいっていれば、 Hello World! と表示されるはずです。

CGI

CGI を試してみましょう。
Aserve での CGI はもちろん Lisp で書きます。そして Aserve と同じ Lisp 上で動きます。
入力され label と href からリンクを作る CGI です。

(use-package :net.aserve)
(use-package :net.html.generator)

(publish
 :path "/input.html"
 :content-type "text/html"
 :function
 #'(lambda (req ent)
     (with-http-response
      (req ent)
      (with-http-body
       (req ent)
       (html
	(:html
	 (:head (:title "input"))
	 (:body
	  ((:form :action "/cgi.html" :method "post")
	   "label"((:input :type "text" :name "label"))
	   :br
	   "href"((:input :type "text" :name "href"))
	   :br
	   ((:input :type "submit"))))))))))

(publish
 :path "/cgi.html"
 :content-type "text/html"
 :function
 #'(lambda (req ent)
     (let* ((label (cdr (assoc "label" (request-query req)
			       :test #'equal)))
	    (href (cdr (assoc "href" (request-query req)
			      :test #'equal))))
       (with-http-response
	(req ent)
	(with-http-body
	 (req ent)
	 (html
	  (:html
	   (:head (:title "cgi"))
	   (:body
	    ((:a :href href) (:princ-safe label))))))))))

・・・おかしいなぁ。結構めんどくさい。 CGI パラメータを取るところと、:princ-safe ってのがひどいなぁ。

UncommonSQL

Lisp で UncommonSQL を使用できるようにするのも require 一発です。

(require :uncommonsql-postgresql)

UncommonSQL にコネクトします。最初の "ancient" はデータベース名、次の "ancient" はデータベースのユーザ名です。

(sql::connect '(nil "ancient" "ancient" nil)
	      :database-type :postgresql)

view class を作ります。

(sql:def-view-class link ()
  ((href
    :accessor href
    :db-kind :key
    :type string
    :initarg :href)
   (label
    :accessor label
    :type string
    :initarg :label))
  (:base-table link))

テーブルを作ります。

(sql:create-view-from-class 'link)

ちなみに、テーブルを削除するには、こうします。

(sql::drop-view-from-class 'link)

link のインスタンスを作って、データベースに格納します。

(setq link1 (make-instance 'link
			   :href "http://yahoo.co.jp/"
			   :label "Yahoo"))
(setq link2 (make-instance 'link
			   :href "http://ancient.s6.xrea.com/lisp/"
			   :label "Lisp"))
(setq link3 (make-instance 'link
			   :href "http://ancient.s6.xrea.com/"
			   :label "ほーむ"))
(sql:store-instance link1)
(sql:store-instance link2)
(sql:store-instance link3)

検索はこんな感じです。 sql:select はリストを返します。

* (href (car (sql:select 'link :where [= [slot-value 'link 'label] "Yahoo"])))
"http://yahoo.co.jp/"

簡単なアプリ

DB に link を登録し、表示する簡単なアプリです。

;; -*- mode: common-lisp; package: kakeibo -*-

(require :aserve)
(require :uncommonsql-postgresql)

(defpackage :link
  (:use :common-lisp-user :common-lisp :net.html.generator :net.aserve :sql))

(in-package :link)

;;;;link
(def-view-class link ()
		    ((href
		      :accessor href
		      :db-kind :key
		      :type string
		      :initarg :href)
		     (label
		      :accessor label
		      :type string
		      :initarg :label))
		    (:base-table link))

(defmethod to-html ((self link))
  (html
   ((:a :href (href self)) (:princ-safe (label self)))))

;;;;;CGI
(publish
 :path "/link/view.html"
 :content-type "text/html; charset=euc-jp"
 :function
 #'(lambda (req ent)
     ;;;;登録
     (let ((label (cdr (assoc "label" (request-query req)
			      :test #'equal)))
	   (href (cdr (assoc "href" (request-query req)
			     :test #'equal))))
       (and label href
	    (store-instance
	     (make-instance 'link :href href :label label))))
     ;;;;HTML表示
     (with-http-response
      (req ent)
      (with-http-body
       (req ent)
       (html
	(:html
	 (:head (:title "Link View"))
	 (:body
	  ((:form :action "/link/view.html" :method "post")
	   "label" ((:input :type "text" :name "label"))
	   :br
	   "href" ((:input :type "text" :name "href"))
	   :br
	   ((:input :type "submit")))
          ;;;DB から link を取得して表示
          (mapcar #'(lambda (l)
                      (to-html l)
                      (html :br))
                  (select 'link)))))))))


;;;;DB接続
(connect '(nil "ancient" "ancient" nil)
	      :database-type :postgresql)

;;;;linkテーブル作デ
(ignore-errors
  (create-view-from-class 'link))

;;;;Aserve start
(let ((*package*))
  (common-lisp-user::init-aserve-cmu))
(start :port 8888)

戻る

ancient@s6.xrea.com