[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[kahua-dev:00663] Re: session と寿命を共にするオブジェクト
久住です．
On 2004/05/13, at 10:25, Shiro Kawai wrote:
<session-state>オブジェクトの内容は、worker processから
kahua-keyservに送られてそこで一元管理してるので、
kahua-keyservは全てのアクティブな<session-state>オブジェクトを
知っていることになります。
なるほどなるほど． serializableなobjectであれば<session-state>に
つっこんで使うのが一番良さそうですね．
＃ しかし， まじめに読んでみて思ったのですが， MOPってすごいですねぇ．
＃ しみじみと感動してしまいました． こんな簡単に分散オブジェクトが
＃ つくれるなんて！
kahua-keyservの方には、全てのアクティブなセッション状態キーを
返すインターフェースが実装されているんですが、worker process
からそれをqueryするAPIがまだ無かったかな。
とりあえず， 書いてみました．
あと， (%ctimeの更新なしに)参照だけしたいことがありましたので，
keyservとsession.scmに， そのようなAPIを追加してみました．
＃ あと， let-keywords*をapplicationの中で使いたくなったので，
＃ その分の変更も含まれてます．
diff -cr Kahua-0.2.5-orig/plugins/allow-module.scm
Kahua/plugins/allow-module.scm
*** Kahua-0.2.5-orig/plugins/allow-module.scm Sat Feb 21 21:24:52 2004
--- Kahua/plugins/allow-module.scm Sat May 15 14:00:45 2004
***************
*** 1,6 ****
--- 1,7 ----
;; allow module as plugin
(allow-module file.util)
(allow-module srfi-1)
+ (allow-module srfi-11)
(allow-module srfi-13)
(allow-module srfi-2)
(allow-module text.parse)
diff -cr 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:34:22 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
diff -cr Kahua-0.2.5-orig/src/kahua/session.scm
Kahua/src/kahua/session.scm
*** Kahua-0.2.5-orig/src/kahua/session.scm Sat Feb 21 21:24:52 2004
--- Kahua/src/kahua/session.scm Sat May 15 17:05:24 2004
***************
*** 47,56 ****
<session-state>
session-state-register
session-state-get
session-state-discard
session-state-sweep
session-state-refresh
! session-flush-all)
)
(select-module kahua.session)
--- 47,59 ----
<session-state>
session-state-register
session-state-get
+ session-state-ref
session-state-discard
session-state-sweep
session-state-refresh
! session-flush-all
! session-state-all-keys
! )
)
(select-module kahua.session)
***************
*** 262,280 ****
;; Returns a session state object corresponding ID.
;; If no session is associated with the ID, a new session state
;; object is created.
! (define (session-state-get id)
! (if (session-server-id)
! (let* ((result (keyserver (list id)))
! (state (make <session-state> :session-id id)))
! (synchronize-session-state state result)
! (session-state-sweep (* 60 (ref (kahua-config) 'timeout-mins)))
! state)
! (let1 state (or (hash-table-get (state-sessions) id #f)
! (hash-table-get (state-sessions)
! (session-state-register id)))
! (session-state-refresh id)
! (session-state-sweep (* 60 (ref (kahua-config) 'timeout-mins)))
! state)))
;; SESSION-STATE-DISCARD id
;; Discards the session specified by ID.
--- 266,290 ----
;; Returns a session state object corresponding ID.
;; If no session is associated with the ID, a new session state
;; object is created.
! (define (session-state-get id . rest)
! (let-keywords* rest ((refresh? :refresh? #t))
! (if (session-server-id)
! (let* ((result (keyserver (if refresh?
! (list id)
! `(ref ,id))))
! (state (make <session-state> :session-id id)))
! (synchronize-session-state state result)
! (session-state-sweep (* 60 (ref (kahua-config)
'timeout-mins)))
! state)
! (let1 state (or (hash-table-get (state-sessions) id #f)
! (hash-table-get (state-sessions)
! (session-state-register id)))
! (if refresh? (session-state-refresh id))
! (session-state-sweep (* 60 (ref (kahua-config)
'timeout-mins)))
! state))))
!
! (define (session-state-ref id)
! (session-state-get id :refresh? #f))
;; SESSION-STATE-DISCARD id
;; Discards the session specified by ID.
***************
*** 300,305 ****
--- 310,320 ----
(keyserver (list id))
(set! (ref (hash-table-get (state-sessions) id) '%timestamp)
(sys-time))))
+
+ (define (session-state-all-keys)
+ (if (session-server-id)
+ (keyserver '(keys))
+ (hash-table-keys (state-sessions))))
;;; common API ----------------------------------------------
diff -cr Kahua-0.2.5-orig/src/kahua-keyserv.in
Kahua/src/kahua-keyserv.in
*** Kahua-0.2.5-orig/src/kahua-keyserv.in Sat Mar 6 08:10:41 2004
--- Kahua/src/kahua-keyserv.in Sat May 15 16:51:50 2004
***************
*** 128,133 ****
--- 129,135 ----
(list (num-objects)))
((stat) (list (num-objects)))
((keys) (all-keys))
+ ((ref) (ref-object (cadr request)))
(else
(handle-object-command request)))
#f)
***************
*** 166,171 ****
--- 168,177 ----
(get-object candidate))))
))
+ (define (ref-object key)
+ (and (string? key)
+ (hash-table-get *object-pool* key #f)))
+
(define (sweep-objects timeout)
(define now (sys-time))
(define (check k v)
diff -cr 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:37:36 2004
***************
*** 323,328 ****
--- 323,336 ----
(sort (hash-table-keys (ref db 'instance-by-key))
(lambda (a b) (string<? (cdr a) (cdr b))))))
+ ;; <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)))))
+
;;----------------------------------------------------------
;; メタ情報履歴に関するテスト：永続クラスの変更をオブジェクトマネージャ
;; が認識し、世代番号を自動的に付与して管理していることを確認する。
Only in Kahua/test: persistence.scm.in~
Only in Kahua/test: plugin.scm
Only in Kahua/test: sandbox.scm
Only in Kahua/test: server.scm
Only in Kahua/test: session.scm
diff -cr Kahua-0.2.5-orig/test/session.scm.in Kahua/test/session.scm.in
*** Kahua-0.2.5-orig/test/session.scm.in Wed Apr 7 18:55:33 2004
--- Kahua/test/session.scm.in Sat May 15 17:04:47 2004
***************
*** 106,111 ****
--- 106,112 ----
(let ((state (session-state-get "nosuchid")))
(list (ref state 'x-slot) (ref state 'y-slot)))))
+
(test* "discarding" '(#f #f)
(begin
(session-state-discard a-state-id)
***************
*** 124,129 ****
--- 125,131 ----
(let ((state (session-state-get "nosuchid")))
(list (ref state 'x-slot) (ref state 'y-slot)))))
+
;;------------------------------------------------------------------
(test-section "session key server")
***************
*** 176,181 ****
--- 178,195 ----
(list (assq-ref (cdr reply) 'tempo)
(assq-ref (cdr reply) 'key))))
+ (test* "ref" '("adagio" D-dur)
+ (let1 reply (get-session-key `(ref ,(car key)))
+ (list (assq-ref (cdr reply) 'tempo)
+ (assq-ref (cdr reply) 'key))))
+
+ (test* "ref (check %ctime is not changed)" #t
+ (let* ((g (get-session-key (list (car key))))
+ (_ (sys-sleep 2))
+ (r (get-session-key `(ref ,(car key)))))
+ (= (assq-ref g '%ctime)
+ (assq-ref r '%ctime))))
+
(test* "admin message (stat)" '(2)
(get-session-key '(stat)))
***************
*** 215,220 ****
--- 229,235 ----
(test* "all-keys" (car (get-session-key '(stat)))
(length (get-session-key '(keys))))
+
)
;;------------------------------------------------------------------
***************
*** 254,259 ****
--- 269,289 ----
(let ((state (session-state-get "nosuchid")))
(list (ref state 'x-slot) (ref state 'y-slot)))))
+ (test* "session-state-ref" '(x y)
+ (begin
+ (let ((state (session-state-ref "nosuchid")))
+ (set! (ref state 'x-slot) 'x)
+ (set! (ref state 'y-slot) 'y))
+ (let ((state (session-state-ref "nosuchid")))
+ (list (ref state 'x-slot) (ref state 'y-slot)))))
+
+ (test* "session-state-ref (timestamp is not changed)" #t
+ (let* ((g (session-state-get "nosuchid"))
+ (_ (sys-sleep 2))
+ (r (session-state-ref "nosuchid")))
+ (= (ref g '%timestamp)
+ (ref r '%timestamp))))
+
(test* "sweep" '(x y)
(begin
(session-state-sweep 10000)
***************
*** 265,270 ****
--- 295,306 ----
(session-state-sweep -1)
(let ((state (session-state-get "nosuchid")))
(list (ref state 'x-slot) (ref state 'y-slot)))))
+
+ (set! a-state-id (session-state-register))
+ (set! b-state-id (session-state-register))
+
+ (test* "session-state-all-keys" (sort (list a-state-id b-state-id
"nosuchid"))
+ (sort (session-state-all-keys)))
(when kserv
(process-send-signal kserv SIGHUP)