自分で使うためにいくつかユーティリティ的なものを書いた。粗末だけど取りあえず動いてます。取りあえずさらしておくことに。
そういえば、dbi-connect には undocumented な auto-commit キーワード引数があるっぽい。
with-connection
(use dbi)
(use gauche.parameter)
(define *db* (make-parameter #f))
(define *dsn* (make-parameter #f))
(define *username* (make-parameter #f))
(define *password* (make-parameter #f))
(define-syntax with-connection
(syntax-rules ()
((_ (*db* dsn) . body)
(with-connection
(*db* dsn (lambda (dsn)
(dbi-connect dsn)))
. body))
((_ (*db* dsn username password) . body)
(with-connection
(*db* dsn (lambda (dsn)
(dbi-connect dsn
:username username
:password password)))
. body))
((_ (*db* dsn connector) . body)
(parameterize
((*db* (connector dsn)))
(guard (e (else
(dbi-close (*db*))
(raise e)))
(begin0
(begin . body)
(dbi-close (*db*))))))))
.NET の ConnectionStringBuilder みたいなのが欲しいなと思って。
dsn
(use util.match)
(define-class <dsn> ()
((platform :init-keyword :platform :initi-value #f)
(dbname :init-keyword :dbname :init-value #f)
(host :init-keyword :host :init-value #f)
(port :init-keyword :port :init-value #f)
(dsn :init-keyword :dsn :init-value #f)))
(define (%ref-join obj name delim)
(if-let1 v (~ obj name)
(string-append
(symbol->string name) delim v)
v))
(define-method build! ((con <dsn>))
(let1 g (cut %ref-join con <> "=")
(let ((platform (string-append
"dbi" ":" (or (~ con 'platform) "")))
(dbname (g 'dbname))
(host (g 'host))
(port (g 'port)))
(let1 constr (string-append
platform
(if-let1 dbname dbname
(string-append ":" dbname)
""))
(when host
(set! constr (string-append constr ";" host)))
(when port
(set! constr (string-append constr ";" port)))
constr))))
(define (build-dsn platform . keys)
(let-keywords* keys ((dbname #f)(host #f)(port #f))
(build! (apply make <dsn>
:platform platform keys))))
(define (%split-constring constring splitter)
(let1 splitted (string-split constring splitter)
(match splitted
((base)(values base #f #f))
((base host)(values base host #f))
((base host port)(values base host port))
(else (values #f #f #f)))))
(define (%split-base base splitter)
(let1 splitted (string-split base splitter)
(match splitted
((dbi)(values dbi #f #f))
((dbi platform)(values dbi platform #f))
((dbi platform dbname)(values dbi platform dbname))
(else (values #f #f #f)))))
(define-method decompose! ((con <dsn>) constring)
(let1 v (^n (list-ref (string-split n "=") 1))
(receive (base host port)
(%split-constring constring ";")
(when base
(receive (dbi platform dbname)
(%split-base base ":")
(set! (~ con 'platform) platform)
(set! (~ con 'dbname)(v dbname))))
(when host
(set! (~ con 'host)(v host)))
(when port
(set! (~ con 'port)(v port)))
con)))
transaction, call-with-transaction など。なぜだか transaction クラスを作りました。connection もクラスにしとけばよかったかなと思います。
(use dbi)
(define-class <transaction> ()
((connection :init-keyword :connection)
(begin-query :init-keyword :begin-query :init-value #f)
(commit-query :init-keyword :commit-query :init-value #f)
(rollback-query :init-keyword :rollback-query :init-value #f)
(state :init-keyword :state :init-value 'ready)))
(define-class <pg-transaction> (<transaction>)())
(define-method initialize ((tran <pg-transaction>) initargs)
(next-method)
(set! (~ tran 'begin-query) "begin;")
(set! (~ tran 'commit-query) "commit;")
(set! (~ tran 'rollback-query) "rollback;"))
(define-method transaction-begin ((tran <transaction>))
(rlet1 r (dbi-do (~ tran 'connection)(~ tran 'begin-query))
(set! (~ tran 'state) 'begin)))
(define-method transaction-commit ((tran <transaction>))
(rlet1 r (dbi-do (~ tran 'connection)(~ tran 'commit-query))
(set! (~ tran 'state) 'committed)))
(define-method transaction-rollback ((tran <transaction>))
(rlet1 r (dbi-do (~ tran 'connection)(~ tran 'rollback-query))
(set! (~ tran 'state) 'rollbacked)))
(define (call-with-transaction proc)
(let1 tran (make <pg-transaction>
:connection (*db*))
(guard (e ((<dbi-error> e)
(transaction-rollback tran)
(raise e))
(else (raise e)))
(transaction-begin tran)
(rlet1 r (proc tran)
(unless (let1 state (~ tran 'state)
(or (eq? state 'commeted)
(eq? state 'rollbacked)))
(transaction-commit tran))))))
使う前に少し設定が必要になりますね。
(use file.util)
(use util.list)
(define-constant +server-bin-dir+ "/some/foo/bar")
(define-constant +db-config+
(load-config (build-path +server-bin-dir+ "conf/db.conf")))
(define (init-module-dbi)
(let* ((platform (assoc-ref +db-config+ 'db-platform))
(host (assoc-ref +db-config+ 'db-host))
(port (assoc-ref +db-config+ 'db-port))
(dbname (assoc-ref +db-config+ 'db-dbname))
(user (assoc-ref +db-config+ 'db-user))
(password (assoc-ref +db-config+ 'db-password)))
(*dsn* (build-dsn platform
:host host
:port port
:dbname dbname))
(*username* user)
(*password* password)))
db.conf は例えばこんなの。load-config はここに載ってませんが、load-config で db.conf 読み込むと alist になるような手続きです。
(db-platform "pg")
(db-host "hogehoge.com")
(db-port "5432")
(db-dbname "fuga")
with-connection は with-db を参考にしました。
他