61 lines
1.6 KiB
Factor
61 lines
1.6 KiB
Factor
! Copyright (C) 2008 Doug Coleman.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: arrays combinators continuations fry io io.backend
|
|
io.directories io.directories.hierarchy io.files io.pathnames
|
|
kernel math math.bitwise math.parser namespaces random
|
|
sequences system vocabs.loader ;
|
|
IN: io.files.unique
|
|
|
|
HOOK: touch-unique-file io-backend ( path -- )
|
|
HOOK: temporary-path io-backend ( -- path )
|
|
|
|
SYMBOL: unique-length
|
|
SYMBOL: unique-retries
|
|
|
|
10 unique-length set-global
|
|
10 unique-retries set-global
|
|
|
|
<PRIVATE
|
|
|
|
: random-letter ( -- ch )
|
|
26 random { CHAR: a CHAR: A } random + ;
|
|
|
|
: random-ch ( -- ch )
|
|
{ t f } random
|
|
[ 10 random CHAR: 0 + ] [ random-letter ] if ;
|
|
|
|
: random-name ( n -- string )
|
|
[ random-ch ] "" replicate-as ;
|
|
|
|
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 )
|
|
[ temporary-path ] 2dip (make-unique-file) ;
|
|
|
|
: make-unique-file* ( prefix suffix -- path )
|
|
[ current-directory get ] 2dip (make-unique-file) ;
|
|
|
|
: with-unique-file ( prefix suffix quot: ( path -- ) -- )
|
|
[ make-unique-file ] dip [ delete-file ] bi ; inline
|
|
|
|
: make-unique-directory ( -- path )
|
|
[
|
|
temporary-path unique-length get random-name append-path
|
|
dup make-directory
|
|
] unique-retries get retry ;
|
|
|
|
: with-unique-directory ( quot: ( -- ) -- )
|
|
[ make-unique-directory ] dip
|
|
'[ _ with-directory ] [ delete-tree ] bi ; inline
|
|
|
|
{
|
|
{ [ os unix? ] [ "io.files.unique.unix" ] }
|
|
{ [ os windows? ] [ "io.files.unique.windows" ] }
|
|
} cond require
|