Hunchentoot と Elephant の CLSQL バックエンド を使うとき

DB 接続がクローズされなくて泣く。 Elephant のバージョンは Elephant 1.0 Alpha 2 (January 15th, 2008)。もしかしたら開発バージョンの Elephant ではなおっているかもしれないけど未調査。

そういえば Weblocks では CLSQL-Fluid が使われていたな。

そんなこんなで次のようなコードを書いて対応した。

(defclass my-acceptor (hunchentoot:acceptor)
  ((lock :initform (bt:make-lock))))

(defmethod hunchentoot:process-connection :around ((self my-acceptor) (socket t))
  "Elephant はスレッド毎に DB の接続をオープンするが、それをハッシュテーブルに保持したままクローズしようとしない。
Hunchentoot はリクエスト毎にスレッドを作って使い捨てている。
ということで、リクエストが完了した時点で DB クローズ行うようにする。"
  (unwind-protect
       (call-next-method)
    (bt:with-lock-held ((slot-value self 'lock))
      (let* ((dbcons (db-clsql::controller-db-table elephant:*store-controller*))
             (db (gethash (bt:current-thread) dbcons)))
        (when (db-clsql::connection-ok-p-con db)
          (clsql-sys:disconnect :database db))
        (remhash (bt:current-thread) dbcons)))))

;; start
(hunchentoot:start (make-instance 'my-acceptor)

Common Lisp で2点間の距離を求める

緯度経度から距離を求めたくなった。手段は色々あると思うが Common Lisp には cl-geo なるものがあるらしい。

依存ライブラリのうち cl-rsm-queue の一次配布先が分からなかったので http://packages.debian.org/ja/etch/cl-rsm-queue からダウンロード。

(require :geo)
(let ((x (make-instance 'geo:point-deg :latitude 35.45083 :longitude 139.53511))
      (y (make-instance 'geo:point-deg :latitude 35.42414 :longitude 139.52657)))
  (geo:kilometers  (geo:distance-between x y)))
 ; => 3.067633887932851d0

目的は果せた。

Google マップをちょっと便利にする

「マイマップ」->「コンテンツを追加」で「距離測定ツール」と「GPS Location」と「CL-USER Google map」を追加する。

これで2点間の距離と各点の緯度経度と Common Lisp ユーザの生息地が分かる。

CLSQL MySQL UTF8

次の3つを utf8 にすれば大丈夫みたい。きっとね。

• character_set_client
• character_set_connection
• character_set_results

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :clsql))

(clsql-sys:connect '("localhost" "blog_development" "root" "")
                   :database-type :mysql)

(clsql-sys:execute-command "set character_set_client='utf8'")
(clsql-sys:execute-command "set character_set_connection='utf8'")
(clsql-sys:execute-command "set character_set_results='utf8'")
;;(clsql-sys:query "show variables like 'char%'")

(clsql-sys:query "select 'まみむめも♪', posts.* from posts")

第1回 Scheme コードバトン

第1回 Scheme コードバトンのお知らせ - ひげぽん OSとか作っちゃうかMona- に参加しました。

1. higepon さん http://gist.github.com/273431 http://d.hatena.ne.jp/higepon/20100110/1263121990
2. g000001 さん http://gist.github.com/273441 http://cadr.g.hatena.ne.jp/g000001/20100111/1263204766
3. aka さん http://gist.github.com/273567 http://aka-cs-blog.blogspot.com/2010/01/scheme.html
4. 私(quek) http://gist.github.com/274187

ときて次は snmsts さんにお願いしました。

higepon さんのとろでは Scheme でのコマンドラインツールでした。 g000001 さんのところで Common Lisp での repl 上のツール（関数）になっています。 aka さんのところで単語登録ができるようになりました。

私の変更は次のとおりです。

• "~" を解釈しない Common Lisp なので (merge-pathnames ".hige/words.txt" (user-homedir-pathname)
• (probe-file dict-file) で辞書ファイルの存在をチェックして
• 辞書ファイルがない場合は (ensure-directories-exist dict-file) でディレクトリだけは作成しておく

この遊びは面白いですね。変更量も変更内容も人それぞれで、コードを読むのが楽しいです。

Shibuya.lisp という名前の CL ユーティリティ集

Shibuya.lispという名前でCLのユーティリティ集を始めてみました - わだばLisperになる - cadr group

ということなので、fork して with-ca/dr をコミットし pull request しました。ちなみに with-ca/dr 次のようなマクロです。

(defmacro with-ca/dr (cons &body body)
  (let ((ca/dr (gensym)))
    `(let* ((,ca/dr ,cons)
            (car (car ,ca/dr))
            (cdr (cdr ,ca/dr)))
       ,@body)))

;; 使い方
(let ((x '(1 2 3)))
  (with-ca/dr x
    (list car cdr)))
;; => (1 (2 3))

Lisp2 なだけです。