steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More robust Linux monitors

db4
slava 2008-04-21 06:13:57 -05:00
parent 9dfdc2f872
commit a471eab19a
3 changed files with 29 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/io/monitors/monitors-tests.factor
View File

@ -33,7 +33,6 @@ os { winnt linux macosx } member? [
[ ] [ "m" get dispose ] unit-test [ ] [ "m" get dispose ] unit-test
] with-monitors ] with-monitors
[ [
[ "monitor-test" temp-file delete-tree ] ignore-errors [ "monitor-test" temp-file delete-tree ] ignore-errors
@ -88,4 +87,7 @@ os { winnt linux macosx } member? [
[ ] [ "m" get dispose ] unit-test [ ] [ "m" get dispose ] unit-test
] with-monitors ] with-monitors
! Out-of-scope disposal should not fail
[ "" resource-path t <monitor> ] with-monitors dispose
] when ] when

20
extra/io/monitors/recursive/recursive.factor
View File

@ -1,15 +1,16 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors sequences assocs arrays continuations combinators kernel USING: accessors sequences assocs arrays continuations combinators kernel
threads concurrency.messaging concurrency.mailboxes threads concurrency.messaging concurrency.mailboxes concurrency.promises
concurrency.promises io.files io.monitors debugger ;
io.files io.monitors ;
IN: io.monitors.recursive IN: io.monitors.recursive
! Simulate recursive monitors on platforms that don't have them ! Simulate recursive monitors on platforms that don't have them
TUPLE: recursive-monitor < monitor children thread ready ; TUPLE: recursive-monitor < monitor children thread ready ;
: notify? ( -- ? ) monitor tget ready>> promise-fulfilled? ;
DEFER: add-child-monitor DEFER: add-child-monitor
: qualify-path ( path -- path' ) : qualify-path ( path -- path' )
@ -17,25 +18,22 @@ DEFER: add-child-monitor
: add-child-monitors ( path -- ) : add-child-monitors ( path -- )
#! We yield since this directory scan might take a while. #! We yield since this directory scan might take a while.
[ directory* [ first add-child-monitor ] each yield ;
directory* [ first add-child-monitor yield ] each
] curry ignore-errors ;
: add-child-monitor ( path -- ) : add-child-monitor ( path -- )
notify? [ dup { +add-file+ } monitor tget queue-change ] when
qualify-path dup link-info type>> +directory+ eq? [ qualify-path dup link-info type>> +directory+ eq? [
[ add-child-monitors ] [ add-child-monitors ]
[
[ [
[ f my-mailbox (monitor) ] keep [ f my-mailbox (monitor) ] keep
monitor tget children>> set-at monitor tget children>> set-at
] curry ignore-errors
] bi ] bi
] [ drop ] if ; ] [ drop ] if ;
USE: io
USE: prettyprint
: remove-child-monitor ( monitor -- ) : remove-child-monitor ( monitor -- )
monitor tget children>> delete-at* monitor tget children>> delete-at* [ dispose ] [ drop ] if ;
[ dispose ] [ drop ] if ;
M: recursive-monitor dispose M: recursive-monitor dispose
dup queue>> closed>> [ dup queue>> closed>> [

23
extra/io/unix/linux/monitors/monitors.factor
View File

@ -8,16 +8,18 @@ math math.bitfields sets alien alien.strings alien.c-types
vocabs.loader accessors system hashtables ; vocabs.loader accessors system hashtables ;
IN: io.unix.linux.monitors IN: io.unix.linux.monitors
TUPLE: linux-monitor < monitor wd ;
: <linux-monitor> ( wd path mailbox -- monitor )
linux-monitor new-monitor
swap >>wd ;
SYMBOL: watches SYMBOL: watches
SYMBOL: inotify SYMBOL: inotify
TUPLE: linux-monitor < monitor wd inotify watches ;
: <linux-monitor> ( wd path mailbox -- monitor )
linux-monitor new-monitor
inotify get >>inotify
watches get >>watches
swap >>wd ;
: wd>monitor ( wd -- monitor ) watches get at ; : wd>monitor ( wd -- monitor ) watches get at ;
: <inotify> ( -- port/f ) : <inotify> ( -- port/f )
@ -53,8 +55,13 @@ M: linux (monitor) ( path recursive? mailbox -- monitor )
] if ; ] if ;
M: linux-monitor dispose ( monitor -- ) M: linux-monitor dispose ( monitor -- )
[ wd>> watches get delete-at ] dup inotify>> closed>> [ drop ] [
[ wd>> inotify-fd swap inotify_rm_watch io-error ] bi ; [ [ wd>> ] [ watches>> ] bi delete-at ]
[
[ inotify>> handle>> ] [ wd>> ] bi
inotify_rm_watch io-error
] bi
] if ;
: ignore-flags? ( mask -- ? ) : ignore-flags? ( mask -- ? )
{ {