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

redo much of io.files.unique -- add unique-file to replace temp-file

db4
Doug Coleman 2009-01-26 15:05:15 -06:00
parent f17c8b72ee
commit 4d64474d18
6 changed files with 124 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/io/files/links/unix/unix-tests.factor
View File

@ -9,24 +9,30 @@ IN: io.files.links.unix.tests
[ t ] [
[
5 "lol" make-test-links
"lol1" follow-links
current-directory get "lol5" append-path =
] with-unique-directory
current-temporary-directory get [
5 "lol" make-test-links
"lol1" follow-links
current-temporary-directory get "lol5" append-path =
] with-directory
] cleanup-unique-directory
] unit-test
[
[
100 "laf" make-test-links "laf1" follow-links
current-temporary-directory get [
100 "laf" make-test-links "laf1" follow-links
] with-directory
] with-unique-directory
] [ too-many-symlinks? ] must-fail-with
[ t ] [
110 symlink-depth [
[
100 "laf" make-test-links
"laf1" follow-links
current-directory get "laf100" append-path =
] with-unique-directory
current-temporary-directory get [
100 "laf" make-test-links
"laf1" follow-links
current-temporary-directory get "laf100" append-path =
] with-directory
] cleanup-unique-directory
] with-variable
] unit-test

75
basis/io/files/unique/unique-docs.factor
View File

@ -1,8 +1,9 @@
USING: help.markup help.syntax io io.ports kernel math
io.pathnames io.directories math.parser io.files strings ;
io.pathnames io.directories math.parser io.files strings
quotations io.files.unique.private ;
IN: io.files.unique
HELP: temporary-path
HELP: default-temporary-directory
{ $values
{ "path" "a pathname string" }
}
@ -25,42 +26,66 @@ HELP: unique-retries
HELP: make-unique-file ( prefix suffix -- path )
{ $values { "prefix" "a string" } { "suffix" "a string" }
{ "path" "a pathname string" } }
{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
{ $description "Creates a file that is guaranteed not to exist in the directory stored in " { $link current-temporary-directory } ". The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
HELP: make-unique-file*
{ $values
{ "prefix" string } { "suffix" string }
{ "path" "a pathname string" }
}
{ $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ;
{ unique-file make-unique-file cleanup-unique-file } related-words
{ make-unique-file make-unique-file* with-unique-file } related-words
HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
HELP: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- )
{ $values { "prefix" "a string" } { "suffix" "a string" }
{ "quot" "a quotation" } }
{ $description "Creates a file with " { $link make-unique-file } " and calls the quotation with the path name on the stack." }
{ $notes "The unique file will be deleted after calling this word." } ;
HELP: make-unique-directory ( -- path )
HELP: unique-directory ( -- path )
{ $values { "path" "a pathname string" } }
{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
{ $description "Creates a directory in the value in " { $link current-temporary-directory } " that is guaranteed not to exist in and returns the full pathname." }
{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
HELP: with-unique-directory ( quot -- )
HELP: cleanup-unique-directory ( quot -- )
{ $values { "quot" "a quotation" } }
{ $description "Creates a directory with " { $link make-unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-directory } " combinator. The quotation can access the " { $link current-directory } " symbol for the name of the temporary directory." }
{ $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation." } ;
{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." }
{ $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation. This combinator is like " { $link with-unique-directory } " but does not delete the directory." } ;
ARTICLE: "io.files.unique" "Temporary files"
"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl
"Creating temporary files:"
HELP: with-unique-directory
{ $values
{ "quot" quotation }
{ "path" "a pathname string" }
}
{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." } ;
HELP: current-temporary-directory
{ $values
{ "value" "a path" }
}
{ $description "The temporary directory used for creating unique files and directories." } ;
HELP: unique-file
{ $values
{ "path" "a pathname string" }
{ "path'" "a pathname string" }
}
{ $description "Creates a temporary file in the directory stored in " { $link current-temporary-directory } " and outputs the path name." } ;
HELP: with-temporary-directory
{ $values
{ "path" "a pathname string" } { "quot" quotation }
}
{ $description "Sets " { $link current-temporary-directory } " to " { $snippet "path" } " and calls the quotation, restoring the previous temporary path after execution completes." } ;
ARTICLE: "io.files.unique" "Unique files"
"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform unique file creation in temporary directories in a high-level and secure way." $nl
"Changing the temporary path:"
{ $subsection current-temporary-directory }
"Creating unique files:"
{ $subsection unique-file }
{ $subsection cleanup-unique-file }
{ $subsection make-unique-file }
{ $subsection make-unique-file* }
{ $subsection with-unique-file }
"Creating temporary directories:"
{ $subsection make-unique-directory }
{ $subsection with-unique-directory } ;
"Creating unique directories:"
{ $subsection unique-directory }
{ $subsection with-unique-directory }
{ $subsection cleanup-unique-directory }
"Default temporary directory:"
{ $subsection default-temporary-directory } ;
ABOUT: "io.files.unique"

26
basis/io/files/unique/unique-tests.factor
View File

@ -7,15 +7,35 @@ IN: io.files.unique.tests
"core" ".test" [
[ [ 123 CHAR: a <repetition> ] dip ascii set-file-contents ]
[ file-info size>> ] bi
] with-unique-file
] cleanup-unique-file
] unit-test
[ t ] [
[ current-directory get file-info directory? ] with-unique-directory
[ current-directory get file-info directory? ] cleanup-unique-directory
] unit-test
[ t ] [
current-directory get
[ [ "FAILDOG" throw ] with-unique-directory ] [ drop ] recover
[ [ "FAILDOG" throw ] cleanup-unique-directory ] [ drop ] recover
current-directory get =
] unit-test
[ t ] [
[
"asdf" unique-file drop
"asdf2" unique-file drop
current-temporary-directory get directory-files length 2 =
] cleanup-unique-directory
] unit-test
[ t ] [
[ ] with-unique-directory >boolean
] unit-test
[ t ] [
[
"asdf" unique-file drop
"asdf" unique-file drop
current-temporary-directory get directory-files length 2 =
] with-unique-directory drop
] unit-test

49
basis/io/files/unique/unique.factor
View File

@ -6,8 +6,13 @@ 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 )
HOOK: (touch-unique-file) io-backend ( path -- )
: touch-unique-file ( path -- )
normalize-path (touch-unique-file) ;
HOOK: default-temporary-directory io-backend ( -- path )
SYMBOL: current-temporary-directory
SYMBOL: unique-length
SYMBOL: unique-retries
@ -15,6 +20,9 @@ SYMBOL: unique-retries
10 unique-length set-global
10 unique-retries set-global
: with-temporary-directory ( path quot -- )
[ current-temporary-directory ] dip with-variable ; inline
<PRIVATE
: random-letter ( -- ch )
@ -24,37 +32,44 @@ SYMBOL: unique-retries
{ t f } random
[ 10 random CHAR: 0 + ] [ random-letter ] if ;
: random-name ( n -- string )
[ random-ch ] "" replicate-as ;
PRIVATE>
: random-name ( -- string )
unique-length get [ random-ch ] "" replicate-as ;
: (make-unique-file) ( path prefix suffix -- path )
'[
_ _ _ unique-length get random-name glue append-path
_ _ _ random-name glue append-path
dup touch-unique-file
] unique-retries get retry ;
PRIVATE>
: make-unique-file ( prefix suffix -- path )
[ temporary-path ] 2dip (make-unique-file) ;
[ current-temporary-directory get ] 2dip (make-unique-file) ;
: make-unique-file* ( prefix suffix -- path )
[ current-directory get ] 2dip (make-unique-file) ;
: with-unique-file ( prefix suffix quot: ( path -- ) -- )
: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- )
[ make-unique-file ] dip [ delete-file ] bi ; inline
: make-unique-directory ( -- path )
: unique-directory ( -- path )
[
temporary-path unique-length get random-name append-path
current-temporary-directory 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
: with-unique-directory ( quot -- path )
[ unique-directory ] dip
[ with-temporary-directory ] [ drop ] 2bi ; inline
: cleanup-unique-directory ( quot: ( -- ) -- )
[ unique-directory ] dip
'[ _ with-temporary-directory ] [ delete-tree ] bi ; inline
: unique-file ( path -- path' )
"" make-unique-file ;
{
{ [ os unix? ] [ "io.files.unique.unix" ] }
{ [ os windows? ] [ "io.files.unique.windows" ] }
} cond require
default-temporary-directory current-temporary-directory set-global

4
basis/io/files/unique/unix/unix.factor
View File

@ -7,7 +7,7 @@ IN: io.files.unique.unix
: open-unique-flags ( -- flags )
{ O_RDWR O_CREAT O_EXCL } flags ;
M: unix touch-unique-file ( path -- )
M: unix (touch-unique-file) ( path -- )
open-unique-flags file-mode open-file close-file ;
M: unix temporary-path ( -- path ) "/tmp" ;
M: unix default-temporary-directory ( -- path ) "/tmp" ;

4
basis/io/files/unique/windows/windows.factor
View File

@ -3,8 +3,8 @@ io.files.windows io.ports windows destructors environment
io.files.unique ;
IN: io.files.unique.windows
M: windows touch-unique-file ( path -- )
M: windows (touch-unique-file) ( path -- )
GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
M: windows temporary-path ( -- path )
M: windows default-temporary-directory ( -- path )
"TEMP" os-env ;