[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[kahua-dev:00660] Re: オブジェクトデータベース
久住です．
On 2004/05/13, at 13:40, 久住憲嗣 wrote:
2. 親:<kahua-persistent-base> -> 子:<hoge> -> 孫1:<fuge>
-> 孫2: <fuge2>
のような関係のクラスを定義して， 孫の<fuge>/<fuge2>のインスタンスを
それぞれいくつかmakeしておいたときに， <fuge>/<fuge2>のすべての
インスタンスの集合を取得する方法はあるのでしょうか．
(make-kahua-collection <hoge>)では， <hoge>の直接のインスタンスの
集合のみ取得できるようです．
あ、この機能はつけようと思ってまだつけてなかった。
make-kahua-collectionにキーワード引数で何か指定したら
サブクラスも検索するようにするつもりでした。
うーん、ちょっといじればできそうだなあ。
あー， 気力がありましたらやってみます．
作ってみました． 今現在(memory上で?)定義されているクラスの継承関係を
もとにcollectionを作成します． 継承関係が変更されると矛盾することが
あるのかもしれません (が， よく考えてません…．)
diff -c -r Kahua-0.2.5-orig/src/kahua/persistence.scm
Kahua/src/kahua/persistence.scm
*** Kahua-0.2.5-orig/src/kahua/persistence.scm Sun Feb 29 20:29:03 2004
--- Kahua/src/kahua/persistence.scm Fri May 14 21:20:01 2004
***************
*** 17,22 ****
--- 17,23 ----
(use gauche.version)
(use gauche.fcntl)
(use gauche.logger)
+ (use gauche.collection)
(export <kahua-persistent-meta> <kahua-persistent-base>
<kahua-persistent-metainfo>
key-of find-kahua-class find-kahua-instance
***************
*** 1081,1090 ****
((instances :init-keyword :instances :init-value '()))
)
(define-method make-kahua-collection ((class <kahua-persistent-meta>)
. opts)
(let1 db (current-db)
(unless db (error "make-kahua-collection: database not active"))
! (make-kahua-collection db class opts)))
(define-method make-kahua-collection ((db <kahua-db-fs>)
class opts)
--- 1082,1103 ----
((instances :init-keyword :instances :init-value '()))
)
+ (define-method append-map (proc (col <collection>))
+ (fold (lambda (v r)
+ (append (proc v) r))
+ '()
+ col))
+
(define-method make-kahua-collection ((class <kahua-persistent-meta>)
. opts)
(let1 db (current-db)
(unless db (error "make-kahua-collection: database not active"))
! (let-keywords* opts ((subclasses? :subclasses #f))
! (if subclasses?
! (append-map (lambda (c)
! (coerce-to <list> (make-kahua-collection db c
opts)))
! (cons class
! (class-subclasses class)))
! (make-kahua-collection db class opts)))))
(define-method make-kahua-collection ((db <kahua-db-fs>)
class opts)
***************
*** 1109,1113 ****
(let1 p (ref coll 'instances)
(proc (cut null? p)
(lambda () (let1 r (car p) (pop! p) r)))))
!
(provide "kahua/persistence")
--- 1122,1137 ----
(let1 p (ref coll 'instances)
(proc (cut null? p)
(lambda () (let1 r (car p) (pop! p) r)))))
!
! (define-method class-subclasses ((class <class>))
! (define-method class-subclasses* ((class <class>))
! (let1 subs (class-direct-subclasses class)
! (if (null? subs)
! '()
! (append subs
! (append-map class-subclasses* subs)))))
!
! (delete-duplicates (class-subclasses* class)))
!
!
(provide "kahua/persistence")
diff -c -r Kahua-0.2.5-orig/test/persistence.scm.in
Kahua/test/persistence.scm.in
*** Kahua-0.2.5-orig/test/persistence.scm.in Wed Apr 7 18:55:33 2004
--- Kahua/test/persistence.scm.in Fri May 14 21:24:12 2004
***************
*** 323,328 ****
--- 323,341 ----
(sort (hash-table-keys (ref db 'instance-by-key))
(lambda (a b) (string<? (cdr a) (cdr b))))))
+ (test* "kahua-test-subclasses" '(1 2 "woo" "wooo")
+ (sort (with-db (db *dbname*)
+ (map (cut ref <> 'id)
+ (make-kahua-collection <kahua-test> :subclasses
#t)))))
+
+ ;; <kahua-test>と，そのsubclassである<kahua-test-sub>両者ともの
+ ;; 永続インスタンスのコレクションを，<kahua-test>に対する
+ ;; make-kahua-collectionを用いて作成できることを確認する．
+ (test* "kahua-test-subclasses" '(1 2 4 5)
+ (sort (with-db (db *dbname*)
+ (map (cut ref <> 'id)
+ (make-kahua-collection <kahua-test> :subclasses
#t)))))
+
;;----------------------------------------------------------
;; メタ情報履歴に関するテスト：永続クラスの変更をオブジェクトマネージャ
;; が認識し、世代番号を自動的に付与して管理していることを確認する。