〜Gauche on Railsへの道〜 2. ActiveRecord 風のものを作る。その3

いよいよ ActiveRecord

ActiveRecordと、そのメタクラスの定義は以下のように対応するテーブルの情報を持つ事にします。
スロット(インスタンス変数)定義で :allocation :class を指定するとクラス全体で共有されるクラス変数になります。 また :allocation :each-subclassを指定すると、共有する範囲が継承したクラスには及びません。

(define-class <active-record-meta> (<class>)
  ())

(define-class <active-record> ()
  ((initialized  :allocation :each-subclass)
   (db-conn :allocation :class)
   (table-name :allocation :each-subclass)
   (column-names :allocation :each-subclass)
   (column-types :allocation :each-subclass))
  :metaclass <active-record-meta>)

スロット(インスタンス変数)の動的な追加

ActiveRecord では、ActiveRecordクラスを継承しテーブルに対応したクラスを定義します。しかし、そのクラス定義にはカラムに対応したインスタンス変数の定義は書きません。
テーブルに対応したクラスが最初に使われる時に、ActiveRecordはテーブル(カラム)の定義情報を取得し、クラスにインスタンス変数を動的に追加します。

この仕掛けを Gauche で作る必要があります。Gaucheのクラスに後からスロット(インスタンス変数)を追加する機能はありませんが、めんどうみの良いクラス再定義機能があるのでこれを使う事にしまました。

以下がテーブルに対応したクラスのインスタンスを作る make メソッドです。まだバグもあるし雑なコードです・・・
再定義されたクラスの実体を取得するのに eval してるのがなんだか嫌です ^^;

(define-method make ((klass <active-record-meta>) . initargs)
  (cond ((class-slot-bound? klass 'initialized) (next-method))
	(else
	 (receive (table-name column-names column-types) (table-info klass)
		  (set! klass (eval (redefine-slot klass column-names) (interaction-environment)))
		  (set! (class-slot-ref klass 'table-name) table-name)
		  (set! (class-slot-ref klass 'column-names) column-names)
		  (set! (class-slot-ref klass 'column-types) column-types)
		  (set! (class-slot-ref klass 'initialized)  #t)
		  (apply next-method (cons klass initargs))))))

(define (table-info klass)
  (unless (class-slot-bound? klass 'db-conn)
	  (set! (class-slot-ref klass 'db-conn) (db-connect)))
  (let* ((table-name (class->table-name klass)))
    (receive (column-names column-types) 
	     (db-column-info (class-slot-ref klass 'db-conn) table-name)
	     (values table-name column-names column-types))))

(define (redefine-slot klass slots-names)
  (let* ((slots (map (lambda(n)
		       `(,(string->symbol n) :init-keyword ,(make-keyword n)
			 :accessor ,(string->symbol #`",|n|-of")))
		     slots-names)))
    (eval `(define-class ,(ref klass 'name) 
	     (,(ref (car (class-direct-supers klass)) 'name)) ,slots)
	  (interaction-environment))))
(define (class->string klass) 
  (symbol->string (ref klass 'name)))

(define (class->table-name klass)
  (regexp-replace-all #/-/ (regexp-replace #/^<(.*)>$/ (class->string klass) "\\1s") "_"))

find(id) メソッド

id指定で1レコードを取得する、findメソッドを作ってみました。
dbi-executeから取得できるselect結果は文字列なので、数値や日付などはGaucheの対応するオブジェクトに変換する必要があります。
あと、select結果から最初の1レコードのみを取得するスマートなやり方が思いつかなっかのでの find 関数を使って見ました。

(define-method find ((klass <active-record-meta>)(id <integer>))
  (let* ((ar (make klass))
	 (query (dbi-prepare (class-slot-ref klass 'db-conn)
			     #`"select * from ,(ref ar 'table-name) where id = ?"))
	 (row (first (dbi-execute query id))))
    (set-ar-columns! ar row)
    ar
    ))

(define-method first ((self <collection>))
  (find (lambda(n) #t) self))

(define (set-ar-columns! ar row)
  (for-each (lambda(v n t)
	      (if v
		  (set! (ref ar (string->symbol n)) 
			(db-result->scheme-object v t))))
	    row
	    (ref ar 'column-names)
	    (ref ar 'column-types)))

(define *db-result->scheme-object-func* (make-hash-table 'string=?))
(hash-table-put! *db-result->scheme-object-func* "int" string->number)
(hash-table-put! *db-result->scheme-object-func* "varchar" cons*)
(hash-table-put! *db-result->scheme-object-func* "text" cons*)
(hash-table-put! *db-result->scheme-object-func* "date" (lambda(s) (string->date s "~Y-~m-~d")))
(hash-table-put! *db-result->scheme-object-func* "datetime" (lambda(s) (string->date s "~Y-~m-~d ~H:~M:~S")))

(define (db-result->scheme-object value type)
  (let ((conv (ref *db-result->scheme-object-func* type #f)))
    (if conv (conv value) value)))

実行結果

gosh> (define-class <todo> (<active-record>) ())     # rubyで書くと class Todo << ActiveRecord; end
<todo>
gosh> (set! t1 (find <todo> 1))    # rubyで書くと t1 = Todo.find(1) 
t1
gosh> (d t1)    # t1 の内容を表示  オブジェクトの内容を表示してくれる d メソッドは便利です ^^)
#<<todo> 0x6ec670> is an instance of class <todo>
slots:
  id        : 1
  due       : #<date 2008/02/10 00:00:00.000000000 (32400)>
  task      : "打ち合わせ"
  memo      : #<unbound>
  created_at: #<date 2008/02/10 23:00:13.000000000 (32400)>
  updated_at: #<unbound>
  initialized: #t
  db-conn   : #<<mysql-connection> 0x133a108>
  table-name: "todos"
  column-names: #("id" "due" "task" "memo" "created_at" "updated_at")
  column-types: #("int" "date" "varchar" "text" "datetime" "datetime")

まだ、バグがあるようで時々へんな動きおしますが ActiveRecord の機能の一部が出来ました \(^O^)/