Support listing resource pool resources
This commit is contained in:
parent
838ee6f1e3
commit
8c63ed7b4e
1 changed files with 15 additions and 0 deletions
|
@ -567,6 +567,16 @@
|
||||||
waiters
|
waiters
|
||||||
resources-last-used))
|
resources-last-used))
|
||||||
|
|
||||||
|
(('list-resources reply)
|
||||||
|
(spawn-fiber
|
||||||
|
(lambda ()
|
||||||
|
(put-message reply (list-copy resources))))
|
||||||
|
|
||||||
|
(loop resources
|
||||||
|
available
|
||||||
|
waiters
|
||||||
|
resources-last-used))
|
||||||
|
|
||||||
(('stats reply)
|
(('stats reply)
|
||||||
(let ((stats
|
(let ((stats
|
||||||
`((resources . ,(length resources))
|
`((resources . ,(length resources))
|
||||||
|
@ -965,3 +975,8 @@ available. Return the resource once PROC has returned."
|
||||||
(raise-exception
|
(raise-exception
|
||||||
(make-resource-pool-timeout-error pool))))))
|
(make-resource-pool-timeout-error pool))))))
|
||||||
|
|
||||||
|
(define (resource-pool-list-resources pool)
|
||||||
|
(let ((reply (make-channel)))
|
||||||
|
(put-message (resource-pool-channel pool)
|
||||||
|
(list 'list-resources reply))
|
||||||
|
(get-message reply)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue