parent
101bc66b2b
commit
154bc260c6
|
@ -1,5 +0,0 @@
|
||||||
USING: io.backend ;
|
|
||||||
IN: io.files.unique.backend
|
|
||||||
|
|
||||||
HOOK: (make-unique-file) io-backend ( path -- )
|
|
||||||
HOOK: temporary-path io-backend ( -- path )
|
|
|
@ -1,11 +1,13 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math math.bitwise math.parser
|
USING: kernel math math.bitwise math.parser random sequences
|
||||||
random sequences continuations namespaces
|
continuations namespaces io.files io arrays system
|
||||||
io.files io arrays io.files.unique.backend system
|
combinators vocabs.loader fry io.backend ;
|
||||||
combinators vocabs.loader fry ;
|
|
||||||
IN: io.files.unique
|
IN: io.files.unique
|
||||||
|
|
||||||
|
HOOK: touch-unique-file io-backend ( path -- )
|
||||||
|
HOOK: temporary-path io-backend ( -- path )
|
||||||
|
|
||||||
SYMBOL: unique-length
|
SYMBOL: unique-length
|
||||||
SYMBOL: unique-retries
|
SYMBOL: unique-retries
|
||||||
|
|
||||||
|
@ -26,12 +28,17 @@ SYMBOL: unique-retries
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
: (make-unique-file) ( path prefix suffix -- path )
|
||||||
|
'[
|
||||||
|
_ _ _ unique-length get random-name glue append-path
|
||||||
|
dup touch-unique-file
|
||||||
|
] unique-retries get retry ;
|
||||||
|
|
||||||
: make-unique-file ( prefix suffix -- path )
|
: make-unique-file ( prefix suffix -- path )
|
||||||
temporary-path -rot
|
[ temporary-path ] 2dip (make-unique-file) ;
|
||||||
[
|
|
||||||
unique-length get random-name glue append-path
|
: make-unique-file* ( prefix suffix -- path )
|
||||||
dup (make-unique-file)
|
[ current-directory get ] 2dip (make-unique-file) ;
|
||||||
] 3curry unique-retries get retry ;
|
|
||||||
|
|
||||||
: with-unique-file ( prefix suffix quot: ( path -- ) -- )
|
: with-unique-file ( prefix suffix quot: ( path -- ) -- )
|
||||||
[ make-unique-file ] dip [ delete-file ] bi ; inline
|
[ make-unique-file ] dip [ delete-file ] bi ; inline
|
||||||
|
|
|
@ -1,13 +1,13 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel io.ports io.unix.backend math.bitwise
|
USING: kernel io.ports io.unix.backend math.bitwise
|
||||||
unix io.files.unique.backend system ;
|
unix system io.files.unique ;
|
||||||
IN: io.unix.files.unique
|
IN: io.unix.files.unique
|
||||||
|
|
||||||
: open-unique-flags ( -- flags )
|
: open-unique-flags ( -- flags )
|
||||||
{ O_RDWR O_CREAT O_EXCL } flags ;
|
{ O_RDWR O_CREAT O_EXCL } flags ;
|
||||||
|
|
||||||
M: unix (make-unique-file) ( path -- )
|
M: unix touch-unique-file ( path -- )
|
||||||
open-unique-flags file-mode open-file close-file ;
|
open-unique-flags file-mode open-file close-file ;
|
||||||
|
|
||||||
M: unix temporary-path ( -- path ) "/tmp" ;
|
M: unix temporary-path ( -- path ) "/tmp" ;
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
USING: kernel system io.files.unique.backend
|
USING: kernel system windows.kernel32 io.windows
|
||||||
windows.kernel32 io.windows io.windows.files io.ports windows
|
io.windows.files io.ports windows destructors environment
|
||||||
destructors environment ;
|
io.files.unique ;
|
||||||
IN: io.windows.files.unique
|
IN: io.windows.files.unique
|
||||||
|
|
||||||
M: windows (make-unique-file) ( path -- )
|
M: windows touch-unique-file ( path -- )
|
||||||
GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
|
GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
|
||||||
|
|
||||||
M: windows temporary-path ( -- path )
|
M: windows temporary-path ( -- path )
|
||||||
|
|
Loading…
Reference in New Issue