2010/01/16

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)

2010/01/13

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

目的は果せた。

2010/01/12

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

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

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

2010/01/11

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) でディレクトリだけは作成しておく

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

2010/01/06

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 なだけです。