] change-file-lines ;
: with-build-images ( quot -- )
+ [ boot-image-names [ absolute-path ] map ] dip
'[
- ! Copy boot images
- boot-image-names current-temporary-directory get copy-files-into
- ! Copy checksums
- checksums-path current-temporary-directory get copy-file-into
- current-temporary-directory get [
+ [
+ ! Copy boot images
+ _ "." copy-files-into
+ ! Copy checksums
+ checksums-path "." copy-file-into
! Rewrite checksum lines with build number
checksum-lines-append-build
! Rename file to file.build-number
- current-directory get directory-files [ dup append-build move-file ] each
- ! Run the quot in the current-directory, which is the unique directory
+ "." directory-files [ dup append-build move-file ] each
+ ! Run the quot in the unique directory
@
- ] with-directory
- ] cleanup-unique-directory ; inline
+ ] cleanup-unique-directory
+ ] with-temp-directory ; inline
: upload-build-images ( -- )
[
[
\ scp-name get-global scp-name or ,
- current-directory get directory-files %
+ "." directory-files %
build-destination ,
] { } make try-process
] with-build-images ;
{ { { "writing" "some" "csv" "tests" } } }
[
- "writing,some,csv,tests"
- "csv-test1-" unique-file utf8
- [ set-file-contents ] [ file>csv ] [ drop delete-file ] 2tri
+ [
+ "writing,some,csv,tests"
+ "csv-test1-" ".csv" unique-file utf8
+ [ set-file-contents ] [ file>csv ] [ drop delete-file ] 2tri
+ ] with-temp-directory
] unit-test
{ t } [
- { { "writing,some,csv,tests" } } dup "csv-test2-"
- unique-file utf8 [ csv>file ] [ file>csv ] 2bi =
+ [
+ { { "writing,some,csv,tests" } } dup
+ "csv-test2-" ".csv" unique-file utf8
+ [ csv>file ] [ file>csv ] 2bi =
+ ] with-temp-directory
] unit-test
{ { { "hello" "" "" "" "goodbye" "" } } }
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators.short-circuit db db.errors
-db.errors.sqlite db.sqlite io.files.unique kernel namespaces
-tools.test ;
+db.errors.sqlite db.sqlite io.files.temp io.files.unique kernel
+namespaces tools.test ;
IN: db.errors.sqlite.tests
-: sqlite-error-test-db-path ( -- path )
- "sqlite" "error-test" make-unique-file ;
+[
+ "sqlite" "error-test" [
-sqlite-error-test-db-path <sqlite-db> [
+ <sqlite-db> [
- [
- "insert into foo (id) values('1');" sql-command
- ] [
- { [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
- ] must-fail-with
+ [
+ "insert into foo (id) values('1');" sql-command
+ ] [
+ { [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
+ ] must-fail-with
- [
- "create table foo(id);" sql-command
- "create table foo(id);" sql-command
- ] [
- { [ sql-table-exists? ] [ table>> "foo" = ] } 1&&
- ] must-fail-with
+ "create table foo(id);" sql-command
-] with-db
+ [
+ "create table foo(id);" sql-command
+ ] [
+ { [ sql-table-exists? ] [ table>> "foo" = ] } 1&&
+ ] must-fail-with
+
+ ] with-db
+ ] cleanup-unique-file
+] with-temp-directory
: create-test-file ( -- path )
test-file-contents
- "ftp.server" "test" make-unique-file
+ "ftp.server" "test" unique-file
[ ascii set-file-contents ] [ normalize-path ] bi ;
: test-ftp-server ( quot -- )
- '[
- current-temporary-directory get
- 0 <ftp-server> [
- "ftp://localhost" >url insecure-addr set-url-addr
- "ftp" >>protocol
- create-test-file >>path
- @
- ] with-threaded-server
- ] cleanup-unique-directory ; inline
+ [
+ '[
+ "." 0 <ftp-server> [
+ "ftp://localhost" >url insecure-addr set-url-addr
+ "ftp" >>protocol
+ create-test-file >>path
+ @
+ ] with-threaded-server
+ ] cleanup-unique-directory
+ ] with-temp-directory ; inline
{ t }
[
[
[
- [ ftp-get ] [ path>> file-name ascii file-contents ] bi
- ] cleanup-unique-working-directory
+ [
+ [ ftp-get ]
+ [ path>> file-name ascii file-contents ] bi
+ ] cleanup-unique-directory
+ ] with-temp-directory
] test-ftp-server test-file-contents =
] unit-test
[
"/" >>path
[
- [ ftp-get ] [ path>> file-name ascii file-contents ] bi
- ] cleanup-unique-working-directory
+ [
+ [ ftp-get ]
+ [ path>> file-name ascii file-contents ] bi
+ ] cleanup-unique-directory
+ ] with-temp-directory
] test-ftp-server test-file-contents =
] must-fail
{ t } [
[
- 10 [ "io.paths.test" "gogogo" make-unique-file ] replicate
- current-temporary-directory get [ ] find-all-files
- ] cleanup-unique-directory [ natural-sort ] same?
+ [
+ 10 [ "io.paths.test" "gogogo" unique-file ] replicate
+ "." [ ] find-all-files
+ ] cleanup-unique-directory [ natural-sort ] same?
+ ] with-temp-directory
] unit-test
{ f } [
{ t } [
[
- current-temporary-directory get
- "the-head" unique-file drop t
- [ file-name "the-head" head? ] find-file string?
- ] cleanup-unique-directory
+ [
+ "the-head" "" unique-file drop
+ "." t [ file-name "the-head" head? ] find-file string?
+ ] cleanup-unique-directory
+ ] with-temp-directory
] unit-test
{ t } [
- [ unique-directory unique-directory ] output>array
- [ [ "abcd" append-path touch-file ] each ]
- [ [ file-name "abcd" = ] find-all-in-directories length 2 = ]
- [ [ delete-tree ] each ] tri
+ [
+ [
+ [ unique-directory unique-directory ] output>array
+ [ [ "abcd" append-path touch-file ] each ]
+ [ [ file-name "abcd" = ] find-all-in-directories length 2 = ]
+ [ [ delete-tree ] each ] tri
+ ] cleanup-unique-directory
+ ] with-temp-directory
] unit-test
{ t } [
{ t } [
[
- current-temporary-directory get [
+ [
5 "lol" make-test-links
"lol1" follow-links
- current-temporary-directory get "lol5" append-path =
- ] with-directory
- ] cleanup-unique-directory
+ "lol5" absolute-path =
+ ] cleanup-unique-directory
+ ] with-temp-directory
] unit-test
[
[
- current-temporary-directory get [
+ [
100 "laf" make-test-links "laf1" follow-links
- ] with-directory
- ] with-unique-directory
+ ] with-unique-directory
+ ] with-temp-directory
] [ too-many-symlinks? ] must-fail-with
{ t } [
110 symlink-depth [
[
- current-temporary-directory get [
+ [
100 "laf" make-test-links
"laf1" follow-links
- current-temporary-directory get "laf100" append-path =
- ] with-directory
- ] cleanup-unique-directory
+ "laf100" absolute-path =
+ ] cleanup-unique-directory
+ ] with-temp-directory
] with-variable
] unit-test
-USING: help.markup help.syntax io.directories quotations strings ;
+USING: help.markup help.syntax io.directories io.pathnames
+quotations strings ;
IN: io.files.unique
-HELP: default-temporary-directory
-{ $values
- { "path" "a pathname string" }
-}
-{ $description "A hook that returns the path of the temporary directory in a platform-specific way. Does not guarantee that path is writable by your user." } ;
-
HELP: touch-unique-file
-{ $values
- { "path" "a pathname string" }
-}
+{ $values { "path" "a pathname string" } }
{ $description "Creates a unique file in a platform-specific way. The file is guaranteed not to exist and is openable by your user." } ;
HELP: unique-length
{ unique-length unique-retries } related-words
-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 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: unique-file
+{ $values { "prefix" string } { "suffix" string } { "path" "a pathname string" } }
+{ $description "Creates a file that is guaranteed not to exist in the " { $link current-directory } ". The file name is composed of a prefix, a " { $link unique-length } " 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 " { $link unique-retries } " number of tries. The most likely error is incorrect directory permissions on the " { $link current-directory } "." } ;
-{ unique-file make-unique-file cleanup-unique-file } related-words
+{ unique-file cleanup-unique-file } related-words
HELP: cleanup-unique-file
-{ $values { "prefix" string } { "suffix" string }
-{ "quot" 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." } ;
+{ $values { "prefix" string } { "suffix" string } { "quot" { $quotation ( path -- ) } } }
+{ $description "Creates a file with " { $link unique-file } " and calls the quotation with the path name on the stack." }
+{ $notes "The unique file will be deleted after calling this word, even if an error is thrown in the quotation." } ;
HELP: unique-directory
{ $values { "path" "a pathname string" } }
-{ $description "Creates a directory in " { $link current-temporary-directory } " that is guaranteed not to exist and return the full pathname. The mechanism for the guarantee of uniqueness is retrying with a randomly generated filename until " { $link make-directory } " does not fail." }
-{ $errors "Throws an error if the directory cannot be created after a number of tries " { $link unique-retries } ". The most likely error is incorrect directory permissions on the temporary directory." } ;
-
-HELP: cleanup-unique-directory
-{ $values { "quot" 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." } ;
+{ $description "Creates a directory in the " { $link current-directory } " that is guaranteed not to exist and return the full pathname. The mechanism for the guarantee of uniqueness is retrying with a " { $link unique-length } " randomly generated filename until " { $link make-directory } " succeeds." }
+{ $errors "Throws an error if the directory cannot be created after a " { $link unique-retries } " number of tries. The most likely error is incorrect directory permissions on the " { $link current-directory } "." } ;
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: copy-file-unique
-{ $values
- { "path" "a pathname string" } { "prefix" string } { "suffix" string }
- { "path'" "a pathname string" }
-}
-{ $description "Copies " { $snippet "path" } " to a new unique file in the directory stored in " { $link current-temporary-directory } ". Returns the new path." } ;
+{ $values { "quot" quotation } { "path" "a pathname string" } }
+{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation using " { $link with-directory } " to set it as the " { $link current-directory } "." } ;
-HELP: move-file-unique
-{ $values
- { "path" "a pathname string" } { "prefix" string } { "suffix" string }
- { "path'" "a pathname string" }
-}
-{ $description "Moves " { $snippet "path" } " to a new unique file in the directory stored in " { $link current-temporary-directory } ". Returns the new path." } ;
-
-HELP: current-temporary-directory
-{ $values
- { "value" "a path" }
-}
-{ $description "The temporary directory used for creating unique files and directories." } ;
-
-HELP: unique-file
-{ $values
- { "prefix" 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: cleanup-unique-directory
+{ $values { "quot" quotation } }
+{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation using " { $link with-directory } " to set it as the " { $link current-directory } "." }
+{ $notes "The unique directory will be deleted after calling this word, even if an error is thrown in the quotation." } ;
-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." } ;
+{ unique-directory with-unique-directory cleanup-unique-directory } related-words
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:"
-{ $subsections current-temporary-directory }
+"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform unique file creation in a high-level and secure way." $nl
"Creating unique files:"
{ $subsections
unique-file
cleanup-unique-file
- make-unique-file
}
"Creating unique directories:"
{ $subsections
unique-directory
with-unique-directory
cleanup-unique-directory
-}
-"Default temporary directory:"
-{ $subsections default-temporary-directory }
-"Copying and moving files to a new unique file:"
-{ $subsections
- copy-file-unique
- move-file-unique
} ;
ABOUT: "io.files.unique"
-USING: io.encodings.ascii sequences strings io io.files accessors
-tools.test kernel io.files.unique namespaces continuations
-io.files.info io.pathnames io.directories ;
+USING: accessors continuations io.directories io.encodings.ascii
+io.files io.files.info io.files.unique io.pathnames kernel
+namespaces sequences strings tools.test ;
IN: io.files.unique.tests
{ 123 } [
- "core" ".test" [
- [ [ 123 CHAR: a <string> ] dip ascii set-file-contents ]
- [ file-info size>> ] bi
- ] cleanup-unique-file
+ [
+ "core" ".test" [
+ [ [ 123 CHAR: a <string> ] dip ascii set-file-contents ]
+ [ file-info size>> ] bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
{ t } [
- [ current-directory get file-info directory? ] cleanup-unique-directory
+ [
+ [ current-directory get file-info directory? ]
+ cleanup-unique-directory
+ ] with-temp-directory
] unit-test
{ t } [
- current-directory get
- [ [ "FAILDOG" throw ] cleanup-unique-directory ] [ drop ] recover
- current-directory get =
+ [
+ current-directory get
+ [ [ "FAILDOG" throw ] cleanup-unique-directory ] [ drop ] recover
+ current-directory get =
+ ] with-temp-directory
] unit-test
{ t } [
[
- "asdf" unique-file drop
- "asdf2" unique-file drop
- current-temporary-directory get directory-files length 2 =
- ] cleanup-unique-directory
+ [
+ "asdf" "" unique-file drop
+ "asdf2" "" unique-file drop
+ "." directory-files length 2 =
+ ] cleanup-unique-directory
+ ] with-temp-directory
] unit-test
{ t } [
- [ ] with-unique-directory >boolean
+ [
+ [ ] with-unique-directory >boolean
+ ] with-temp-directory
] unit-test
{ t } [
[
- "asdf" unique-file drop
- "asdf" unique-file drop
- current-temporary-directory get directory-files length 2 =
- ] with-unique-directory drop
+ [
+ "asdf" "" unique-file drop
+ "asdf" "" unique-file drop
+ "." directory-files length 2 =
+ ] with-unique-directory drop
+ ] with-temp-directory
] unit-test
! 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 locals math math.bitwise math.parser namespaces random
-sequences system vocabs random.data ;
+USING: combinators continuations fry io.backend io.directories
+io.directories.hierarchy io.pathnames kernel locals namespaces
+random.data sequences system vocabs ;
IN: io.files.unique
+<PRIVATE
+
HOOK: (touch-unique-file) io-backend ( path -- )
-: touch-unique-file ( path -- )
- normalize-path (touch-unique-file) ;
-HOOK: default-temporary-directory io-backend ( -- path )
+PRIVATE>
-SYMBOL: current-temporary-directory
+: touch-unique-file ( path -- )
+ normalize-path (touch-unique-file) ;
SYMBOL: unique-length
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-file-name ( -- string )
: retry ( quot: ( -- ? ) n -- )
iota swap [ drop ] prepose attempt-all ; inline
-: (make-unique-file) ( path prefix suffix -- path )
+PRIVATE>
+
+: unique-file ( prefix suffix -- path )
'[
- _ _ _ random-file-name glue append-path
+ current-directory get
+ _ _ random-file-name glue append-path
dup touch-unique-file
] unique-retries get retry ;
-PRIVATE>
-
-: make-unique-file ( prefix suffix -- path )
- [ current-temporary-directory get ] 2dip (make-unique-file) ;
-
-: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- )
- [ make-unique-file ] dip [ delete-file ] bi ; inline
+:: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- )
+ prefix suffix unique-file :> path
+ [ path quot call ] [ path delete-file ] [ ] cleanup ; inline
: unique-directory ( -- path )
[
- current-temporary-directory get
+ current-directory get
random-file-name append-path
dup make-directory
] unique-retries get retry ;
-: 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 ( prefix -- path )
- "" make-unique-file ;
-
-: move-file-unique ( path prefix suffix -- path' )
- make-unique-file [ move-file ] keep ;
-
-: copy-file-unique ( path prefix suffix -- path' )
- make-unique-file [ copy-file ] keep ;
-
-: temporary-file ( -- path ) "" unique-file ;
+:: with-unique-directory ( quot -- path )
+ unique-directory :> path
+ path quot with-directory
+ path ; inline
-:: cleanup-unique-working-directory ( quot -- )
+:: cleanup-unique-directory ( quot -- )
unique-directory :> path
- path [ path quot with-temporary-directory ] with-directory
- path delete-tree ; inline
+ [ path quot with-directory ]
+ [ path delete-tree ] [ ] cleanup ; inline
{
{ [ os unix? ] [ "io.files.unique.unix" ] }
{ [ os windows? ] [ "io.files.unique.windows" ] }
} cond require
-
-default-temporary-directory current-temporary-directory set-global
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel io.ports io.backend.unix math.bitwise
-unix system io.files.unique unix.ffi literals ;
+USING: io.backend.unix io.files.unique.private literals system
+unix unix.ffi ;
IN: io.files.unique.unix
CONSTANT: open-unique-flags flags{ O_RDWR O_CREAT O_EXCL }
M: unix (touch-unique-file) ( path -- )
open-unique-flags file-mode open-file close-file ;
-
-M: unix default-temporary-directory ( -- path ) "/tmp" ;
-USING: destructors environment io.files.unique io.files.windows
-system windows.kernel32 ;
+USING: destructors environment io.files.unique.private
+io.files.windows system windows.kernel32 ;
IN: io.files.unique.windows
M: windows (touch-unique-file) ( path -- )
GENERIC_WRITE CREATE_NEW 0 open-file dispose ;
-
-M: windows default-temporary-directory ( -- path )
- "TEMP" os-env ;
[ ] [
<process>
console-vm-path "-run=hello-world" 2array >>command
- "out.txt" unique-file [ out-path set-global ] keep >>stdout
+ [ "out" ".txt" unique-file ] with-temp-directory
+ [ out-path set-global ] keep >>stdout
try-process
] unit-test
launcher-test-path [
<process>
console-vm-path "-script" "stderr.factor" 3array >>command
- "out.txt" unique-file [ out-path set-global ] keep >>stdout
- "err.txt" unique-file [ err-path set-global ] keep >>stderr
+ [ "out" ".txt" unique-file ] with-temp-directory
+ [ out-path set-global ] keep >>stdout
+ [ "err" ".txt" unique-file ] with-temp-directory
+ [ err-path set-global ] keep >>stderr
try-process
] with-directory
] unit-test
launcher-test-path [
<process>
console-vm-path "-script" "stderr.factor" 3array >>command
- "out.txt" unique-file [ out-path set-global ] keep >>stdout
+ [ "out" ".txt" unique-file ] with-temp-directory
+ [ out-path set-global ] keep >>stdout
+stdout+ >>stderr
try-process
] with-directory
launcher-test-path [
<process>
console-vm-path "-script" "stderr.factor" 3array >>command
- "err2.txt" unique-file [ err-path set-global ] keep >>stderr
+ [ "err2" ".txt" unique-file ] with-temp-directory
+ [ err-path set-global ] keep >>stderr
utf8 <process-reader> stream-lines first
] with-directory
] unit-test
[ ] [
<process>
"cmd.exe /c dir" >>command
- "dir.txt" unique-file [ out-path set-global ] keep >>stdout
+ [ "dir" ".txt" unique-file ] with-temp-directory
+ [ out-path set-global ] keep >>stdout
try-process
] unit-test
] times
{ "Hello appender\r\nÖrjan ågren är åter\r\nHello appender\r\nÖrjan ågren är åter\r\n" } [
- "append-test" unique-file out-path set-global
+ [ "append-test" "" unique-file ] with-temp-directory out-path set-global
2 [
launcher-test-path [
<process>
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs continuations fry http.server io
-io.encodings.ascii io.files io.files.unique
+io.encodings.ascii io.files io.files.temp io.files.unique
io.servers io.streams.duplex io.streams.string
kernel math.ranges mime.multipart multiline namespaces random
sequences sorting strings threads tools.test ;
: mime-test-stream ( -- stream )
upload1
- "mime" "test" make-unique-file ascii
- [ set-file-contents ] [ <file-reader> ] 2bi ;
+ [ "mime" "test" unique-file ] with-temp-directory
+ ascii [ set-file-contents ] [ <file-reader> ] 2bi ;
{ } [ mime-test-stream [ ] with-input-stream ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: accessors ascii assocs byte-arrays combinators fry
hashtables http http.parsers io io.encodings.binary io.files
-io.files.unique io.streams.string kernel math quoting sequences
-splitting ;
+io.files.temp io.files.unique io.streams.string kernel math
+quoting sequences splitting ;
IN: mime.multipart
CONSTANT: buffer-size 65536
] with-output-stream ;
: dump-file ( multipart -- multipart )
- "factor-" "-upload" make-unique-file
+ [ "factor-" "-upload" unique-file ] with-temp-directory
[ >>temp-file ] [ dump-mime-file ] bi ;
: parse-content-disposition-form-data ( string -- hashtable )
! File seeking tests
{ B{ 3 2 3 4 5 } }
[
- "seek-test1" unique-file binary
[
- [
- B{ 1 2 3 4 5 } write
- tell-output 5 assert=
- 0 seek-absolute seek-output
- tell-output 0 assert=
- B{ 3 } write
- tell-output 1 assert=
- ] with-file-writer
- ] [
- file-contents
- ] 2bi
+ "seek-test1" "" [
+ binary
+ [
+ [
+ B{ 1 2 3 4 5 } write
+ tell-output 5 assert=
+ 0 seek-absolute seek-output
+ tell-output 0 assert=
+ B{ 3 } write
+ tell-output 1 assert=
+ ] with-file-writer
+ ] [
+ file-contents
+ ] 2bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
{ B{ 1 2 3 4 3 } }
[
- "seek-test2" unique-file binary
[
- [
- B{ 1 2 3 4 5 } write
- tell-output 5 assert=
- -1 seek-relative seek-output
- tell-output 4 assert=
- B{ 3 } write
- tell-output 5 assert=
- ] with-file-writer
- ] [
- file-contents
- ] 2bi
+ "seek-test2" "" [
+ binary
+ [
+ [
+ B{ 1 2 3 4 5 } write
+ tell-output 5 assert=
+ -1 seek-relative seek-output
+ tell-output 4 assert=
+ B{ 3 } write
+ tell-output 5 assert=
+ ] with-file-writer
+ ] [
+ file-contents
+ ] 2bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
{ B{ 1 2 3 4 5 0 3 } }
[
- "seek-test3" unique-file binary
[
- [
- B{ 1 2 3 4 5 } write
- tell-output 5 assert=
- 1 seek-relative seek-output
- tell-output 6 assert=
- B{ 3 } write
- tell-output 7 assert=
- ] with-file-writer
- ] [
- file-contents
- ] 2bi
+ "seek-test3" "" [
+ binary
+ [
+ [
+ B{ 1 2 3 4 5 } write
+ tell-output 5 assert=
+ 1 seek-relative seek-output
+ tell-output 6 assert=
+ B{ 3 } write
+ tell-output 7 assert=
+ ] with-file-writer
+ ] [
+ file-contents
+ ] 2bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
{ B{ 3 } }
[
- B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
- set-file-contents
- ] [
- [
- tell-input 0 assert=
- -3 seek-end seek-input
- tell-input 2 assert=
- 1 read
- tell-input 3 assert=
- ] with-file-reader
- ] 2bi
+ [
+ "seek-test4" "" [
+ B{ 1 2 3 4 5 } swap binary
+ [
+ set-file-contents
+ ] [
+ [
+ tell-input 0 assert=
+ -3 seek-end seek-input
+ tell-input 2 assert=
+ 1 read
+ tell-input 3 assert=
+ ] with-file-reader
+ ] 2bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
{ B{ 2 } }
[
- B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
- set-file-contents
- ] [
- [
- tell-input 0 assert=
- 3 seek-absolute seek-input
- tell-input 3 assert=
- -2 seek-relative seek-input
- tell-input 1 assert=
- 1 read
- tell-input 2 assert=
- ] with-file-reader
- ] 2bi
+ [
+ "seek-test5" "" [
+ B{ 1 2 3 4 5 } swap binary [
+ set-file-contents
+ ] [
+ [
+ tell-input 0 assert=
+ 3 seek-absolute seek-input
+ tell-input 3 assert=
+ -2 seek-relative seek-input
+ tell-input 1 assert=
+ 1 read
+ tell-input 2 assert=
+ ] with-file-reader
+ ] 2bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
[
- "seek-test6" unique-file binary [
- -10 seek-absolute seek-input
- ] with-file-reader
+ [
+ "seek-test6" "" [
+ binary [
+ -10 seek-absolute seek-input
+ ] with-file-reader
+ ] cleanup-unique-file
+ ] with-temp-directory
] must-fail
{ } [
] unit-test
[
- "non-string-error" unique-file ascii [
- { } write
- ] with-file-writer
+ [
+ "non-string-error" "" [
+ ascii [ { } write ] with-file-writer
+ ] cleanup-unique-file
+ ] with-temp-directory
] [ no-method? ] must-fail-with
[
- "non-byte-array-error" unique-file binary [
- "" write
- ] with-file-writer
+ [
+ "non-byte-array-error" "" [
+ binary [ "" write ] with-file-writer
+ ] cleanup-unique-file
+ ] with-temp-directory
] [ no-method? ] must-fail-with
! What happens if we close a file twice?
{ } [
- "closing-twice" unique-file ascii <file-writer>
- [ dispose ] [ dispose ] bi
+ [
+ "closing-twice" "" [
+ ascii <file-writer>
+ [ dispose ] [ dispose ] bi
+ ] cleanup-unique-file
+ ] with-temp-directory
] unit-test
! Test cwd, cd. You do not want to use with-cd, you want with-directory.
combinators combinators.short-circuit fry io io.backend
io.directories io.directories.hierarchy io.encodings.binary
io.encodings.detect io.encodings.utf8 io.files io.files.info
-io.files.types io.files.unique io.launcher io.pathnames kernel
-locals math math.parser namespaces sequences sorting strings
-system unicode.categories xml.syntax xml.writer xmode.catalog
-xmode.marker xmode.tokens ;
+io.files.temp io.files.types io.files.unique io.launcher
+io.pathnames kernel locals math math.parser namespaces sequences
+sorting strings system unicode.categories xml.syntax xml.writer
+xmode.catalog xmode.marker xmode.tokens ;
IN: codebook
! Usage: "my/source/tree" codebook
</guide>
</package> XML> ;
-: write-dest-file ( xml dest-dir name ext -- )
- append append-path utf8 [ write-xml ] with-file-writer ;
+: write-dest-file ( xml name ext -- )
+ append utf8 [ write-xml ] with-file-writer ;
SYMBOL: kindlegen-path
kindlegen-path [ "kindlegen" ] initialize
dest-dir make-directories
[
- current-temporary-directory get :> temp-dir
- src-dir file-name :> name
- src-dir code-files :> files
+ [
+ src-dir file-name :> name
+ src-dir code-files :> files
- src-dir name files code>opf
- temp-dir name ".opf" write-dest-file
+ src-dir name files code>opf
+ name ".opf" write-dest-file
- "vocab:codebook/cover.jpg" temp-dir copy-file-into
+ "vocab:codebook/cover.jpg" "." copy-file-into
- src-dir name files code>ncx
- temp-dir name ".ncx" write-dest-file
+ src-dir name files code>ncx
+ name ".ncx" write-dest-file
- src-dir name files code>toc-html
- temp-dir "_toc.html" "" write-dest-file
+ src-dir name files code>toc-html
+ "_toc.html" "" write-dest-file
- files [| file |
- src-dir file code>html
- temp-dir file name>> file-html-name "" write-dest-file
- ] each
+ files [| file |
+ src-dir file code>html
+ file name>> file-html-name "" write-dest-file
+ ] each
- temp-dir name ".opf" kindle-path kindlegen
- temp-dir name ".mobi" kindle-path dest-dir copy-file-into
+ "." name ".opf" kindle-path kindlegen
+ "." name ".mobi" kindle-path dest-dir copy-file-into
- dest-dir name ".mobi" kindle-path :> mobi-path
+ dest-dir name ".mobi" kindle-path :> mobi-path
- "Job's finished: " write mobi-path print flush
- ] cleanup-unique-working-directory ;
+ "Job's finished: " write mobi-path print flush
+ ] cleanup-unique-directory
+ ] with-temp-directory ;
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs combinators fry grouping http.client io
-io.encodings.binary io.files io.files.unique json.reader kernel
-locals make namespaces sequences urls ;
+io.encodings.binary io.files io.files.temp io.files.unique
+json.reader kernel locals make namespaces sequences urls ;
IN: google.translate
CONSTANT: google-translate-url "http://ajax.googleapis.com/ajax/services/language/translate"
: translate-tts ( text -- file )
"http://translate.google.com/translate_tts?tl=en" >url
- swap "q" set-query-param "" ".mp3" make-unique-file
- [ download-to ] keep ;
+ swap "q" set-query-param [
+ "" ".mp3" unique-file [ download-to ] keep
+ ] with-temp-directory ;
! Example:
! "dog" "en" "de" translate .
} case ;
:: with-preview ( graph quot: ( path -- ) -- )
- "preview" ".dot" [| code-file |
- "preview" preview-extension [| image-file |
- graph code-file ?encoding write-dot
- code-file image-file try-preview-command
- image-file quot call( path -- )
+ [
+ "preview" ".dot" [| code-file |
+ "preview" preview-extension [| image-file |
+ graph code-file ?encoding write-dot
+ code-file image-file try-preview-command
+ image-file quot call( path -- )
+ ] cleanup-unique-file
] cleanup-unique-file
- ] cleanup-unique-file ;
+ ] with-temp-directory ;
PRIVATE>
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image bootstrap.image.download io
-io.directories io.directories.hierarchy io.files.unique
-io.launcher io.pathnames kernel namespaces sequences
-mason.common mason.config webapps.mason.version.files ;
+io.directories io.directories.hierarchy io.files.temp
+io.files.unique io.launcher io.pathnames kernel namespaces
+sequences mason.common mason.config webapps.mason.version.files ;
IN: webapps.mason.version.source
: clone-factor ( -- )
[ suffix "factor" suffix try-process ] keep ;
: make-source-release ( version git-id -- path )
- "Creating source release..." print flush
- [
- current-temporary-directory get [
+ "Creating source release..." print flush [
+ [
clone-factor prepare-source (make-source-release)
"Package created: " write absolute-path dup print
- ] with-directory
- ] with-unique-directory drop ;
+ ] with-unique-directory drop
+ ] with-temp-directory ;
: upload-source-release ( package version -- )
"Uploading source release..." print flush
projects / factor.git / commitdiff