diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index c918641912..b8cf747106 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -87,6 +87,7 @@ ARTICLE: "io.files" "Basic file operations" { $subsection "fs-meta" } { $subsection "directories" } { $subsection "delete-move-copy" } +{ $subsection "unique" } { $see-also "os" } ; ABOUT: "io.files" diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 55eee65bbf..28f23b0de5 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: io.files USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations ; +IN: io.files + ! Pathnames : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; @@ -50,6 +51,19 @@ TUPLE: no-parent-directory path ; { [ t ] [ drop ] } } cond ; +TUPLE: file-info type size permissions modified ; + +HOOK: file-info io-backend ( path -- info ) + +SYMBOL: +regular-file+ +SYMBOL: +directory+ +SYMBOL: +character-device+ +SYMBOL: +block-device+ +SYMBOL: +fifo+ +SYMBOL: +symbolic-link+ +SYMBOL: +socket+ +SYMBOL: +unknown+ + ! File metadata : stat ( path -- directory? permissions length modified ) normalize-pathname (stat) ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 019f4fe376..08336fd32e 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -170,4 +170,4 @@ MACRO: construct-slots ( assoc tuple-class -- tuple ) >r keep r> rot [ call ] [ 2drop f ] if ; inline : retry ( quot n -- ) - swap [ drop ] swap compose attempt-all ; + swap [ drop ] swap compose attempt-all ; inline diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index b980e99718..c03496530b 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -53,7 +53,8 @@ M: sqlite-result-set dispose ( result-set -- ) M: sqlite-statement bind-statement* ( statement -- ) dup statement-bound? [ dup reset-statement ] when - [ statement-bind-params ] [ statement-handle ] bi sqlite-bind ; + [ statement-bind-params ] [ statement-handle ] bi + sqlite-bind ; M: sqlite-statement bind-tuple ( tuple statement -- ) [ @@ -64,7 +65,7 @@ M: sqlite-statement bind-tuple ( tuple statement -- ) [ sql-spec-type ] tri 3array ] with map ] keep - [ set-statement-bind-params ] keep bind-statement* ; + bind-statement ; : last-insert-id ( -- id ) db get db-handle sqlite3_last_insert_rowid diff --git a/extra/io/files/unique/backend/backend.factor b/extra/io/files/unique/backend/backend.factor new file mode 100644 index 0000000000..228b6881f9 --- /dev/null +++ b/extra/io/files/unique/backend/backend.factor @@ -0,0 +1,5 @@ +USING: io.backend ; +IN: io.files.unique.backend + +HOOK: (make-unique-file) io-backend ( prefix suffix -- stream path ) +HOOK: temporary-path io-backend ( -- path ) diff --git a/extra/io/files/unique/unique-docs.factor b/extra/io/files/unique/unique-docs.factor new file mode 100644 index 0000000000..61f960d9f7 --- /dev/null +++ b/extra/io/files/unique/unique-docs.factor @@ -0,0 +1,50 @@ +USING: help.markup help.syntax io io.nonblocking kernel math +io.files.unique.private math.parser io.files ; +IN: io.files.unique + +ARTICLE: "unique" "Making and using unique files" +"Files:" +{ $subsection make-unique-file } +{ $subsection with-unique-file } +{ $subsection with-temporary-file } +"Directories:" +{ $subsection make-unique-directory } +{ $subsection with-unique-directory } +{ $subsection with-temporary-directory } ; + +ABOUT: "unique" + +HELP: make-unique-file ( prefix suffix -- path stream ) +{ $values { "prefix" "a string" } { "suffix" "a string" } +{ "path" "a pathname string" } { "stream" "an output stream" } } +{ $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 and a " { $link } " stream." } +{ $errors "Throws an error if a new unique file cannot be created after a number of tries. Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." } +{ $see-also with-unique-file } ; + +HELP: make-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." } +{ $errors "Throws an error if the directory cannot be created after a number of tries. Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." } +{ $see-also with-unique-directory } ; + +HELP: with-unique-file ( quot -- path ) +{ $values { "quot" "a quotation" } { "path" "a pathname string" } } +{ $description "Creates a file with " { $link make-unique-file } " and calls " { $link with-stream } " on the newly created file. Returns the full pathname after the stream has been closed." } +{ $notes "The unique file will remain after calling this word." } +{ $see-also with-temporary-file } ; + +HELP: with-unique-directory ( quot -- path ) +{ $values { "quot" "a quotation" } { "path" "a pathname string" } } +{ $description "Creates a directory with " { $link make-unique-directory } " and calls " { $link with-directory } " on the newly created directory. Returns the full pathname after the quotation has been called." } +{ $notes "The directory will remain after calling this word." } +{ $see-also with-temporary-directory } ; + +HELP: with-temporary-file ( quot -- ) +{ $values { "quot" "a quotation" } } +{ $description "Creates a file with " { $link make-unique-file } " and calls " { $link with-stream } " on the newly created file. The file is deleted after the quotation returns." } +{ $see-also with-unique-file } ; + +HELP: with-temporary-directory ( quot -- ) +{ $values { "quot" "a quotation" } } +{ $description "Creates a directory with " { $link make-unique-directory } " and calls " { $link with-directory } " on the newly created directory. The directory is deleted after the quotation returns." } +{ $see-also with-unique-directory } ; diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor new file mode 100644 index 0000000000..b39a14c7f5 --- /dev/null +++ b/extra/io/files/unique/unique.factor @@ -0,0 +1,48 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.bitfields combinators.lib math.parser +random sequences sequences.lib continuations namespaces +io.files io.backend io.nonblocking io arrays +io.files.unique.backend system combinators vocabs.loader ; +IN: io.files.unique + + + +: make-unique-file ( prefix suffix -- path stream ) + temporary-path -rot + [ + unique-length random-name swap 3append path+ + dup (make-unique-file) + ] 3curry unique-retries retry ; + +: with-unique-file ( quot -- path ) + >r f f make-unique-file r> rot [ with-stream ] dip ; inline + +: with-temporary-file ( quot -- ) + with-unique-file delete-file ; inline + +: make-unique-directory ( -- path ) + [ + temporary-path unique-length random-name path+ + dup make-directory + ] unique-retries retry ; + +: with-unique-directory ( quot -- path ) + >r make-unique-directory r> + [ with-directory ] curry keep ; inline + +: with-temporary-directory ( quot -- ) + with-unique-directory delete-tree ; inline diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 7b1c97abbe..a5a4e64c03 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.nonblocking io.unix.backend io.files io -unix unix.stat kernel math continuations math.bitfields byte-arrays -alien ; + unix unix.stat kernel math continuations math.bitfields byte-arrays + alien combinators combinators.cleave calendar ; IN: io.unix.files @@ -68,3 +68,24 @@ M: unix-io delete-directory ( path -- ) M: unix-io copy-file ( from to -- ) >r dup file-permissions over r> (copy-file) chmod io-error ; + +: stat>type ( stat -- type ) + stat-st_mode { + { [ dup S_ISREG ] [ +regular-file+ ] } + { [ dup S_ISDIR ] [ +directory+ ] } + { [ dup S_ISCHR ] [ +character-device+ ] } + { [ dup S_ISBLK ] [ +block-device+ ] } + { [ dup S_ISFIFO ] [ +fifo+ ] } + { [ dup S_ISLNK ] [ +symbolic-link+ ] } + { [ dup S_ISSOCK ] [ +socket+ ] } + { [ t ] [ +unknown+ ] } + } cond nip ; + +M: unix-io file-info ( path -- info ) + stat* { + [ stat>type ] + [ stat-st_size ] + [ stat-st_mode ] + [ stat-st_mtim timespec-sec seconds unix-1970 time+ ] + } cleave + \ file-info construct-boa ; diff --git a/extra/io/unix/files/temporary/temporary.factor b/extra/io/unix/files/temporary/temporary.factor deleted file mode 100644 index 0ac6d7605e..0000000000 --- a/extra/io/unix/files/temporary/temporary.factor +++ /dev/null @@ -1,12 +0,0 @@ -USING: kernel io.nonblocking io.unix.backend math.bitfields -unix io.files.temporary.backend ; -IN: io.unix.files.temporary - -: open-temporary-flags ( -- flags ) - { O_RDWR O_CREAT O_EXCL } flags ; - -M: unix-io (temporary-file) ( path -- duplex-stream ) - open-temporary-flags file-mode open dup io-error - ; - -M: unix-io temporary-path ( -- path ) "/tmp" ; diff --git a/extra/io/unix/files/unique/unique.factor b/extra/io/unix/files/unique/unique.factor new file mode 100644 index 0000000000..185d9cd405 --- /dev/null +++ b/extra/io/unix/files/unique/unique.factor @@ -0,0 +1,12 @@ +USING: kernel io.nonblocking io.unix.backend math.bitfields +unix io.files.unique.backend ; +IN: io.unix.files.unique + +: open-unique-flags ( -- flags ) + { O_RDWR O_CREAT O_EXCL } flags ; + +M: unix-io (make-unique-file) ( path -- duplex-stream ) + open-unique-flags file-mode open dup io-error + ; + +M: unix-io temporary-path ( -- path ) "/tmp" ; diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index e740561cf9..b7111c5eac 100755 --- a/extra/io/unix/unix.factor +++ b/extra/io/unix/unix.factor @@ -1,6 +1,6 @@ USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts -io.unix.launcher io.unix.mmap io.backend combinators namespaces -system vocabs.loader sequences ; +io.unix.launcher io.unix.mmap io.backend io.unix.files.unique +combinators namespaces system vocabs.loader sequences ; "io.unix." os append require diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor new file mode 100644 index 0000000000..5f11bf6142 --- /dev/null +++ b/extra/io/windows/files/unique/unique.factor @@ -0,0 +1,8 @@ +USING: kernel system io.files.unqiue io.files.unique.backend ; +IN: io.windows.files.unique + +M: windows-io (make-unique-file) ( path -- stream ) + GENERIC_WRITE CREATE_NEW 0 open-file 0 ; + +M: windows-io temporary-path ( -- path ) + "TEMP" os-env ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 9f2f2db0a5..06dbaf89f7 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays destructors io io.backend io.buffers io.files io.nonblocking io.sockets io.binary -io.sockets.impl windows.errors strings io.streams.duplex kernel -math namespaces sequences windows windows.kernel32 -windows.shell32 windows.types windows.winsock splitting -continuations math.bitfields ; +io.sockets.impl io.windows.files.unique windows.errors +strings io.streams.duplex kernel math namespaces sequences +windows windows.kernel32 windows.shell32 windows.types +windows.winsock splitting continuations math.bitfields ; IN: io.windows TUPLE: windows-nt-io ; diff --git a/extra/unix/stat/macosx/macosx.factor b/extra/unix/stat/macosx/macosx.factor index 1cb3994708..3741a22413 100644 --- a/extra/unix/stat/macosx/macosx.factor +++ b/extra/unix/stat/macosx/macosx.factor @@ -27,3 +27,7 @@ C-STRUCT: stat FUNCTION: int stat ( char* pathname, stat* buf ) ; FUNCTION: int lstat ( char* pathname, stat* buf ) ; + +: stat-st_atim stat-st_atimespec ; +: stat-st_mtim stat-st_mtimespec ; +: stat-st_ctim stat-st_ctimespec ; \ No newline at end of file diff --git a/extra/unix/stat/stat.factor b/extra/unix/stat/stat.factor index ca0736b6d4..204321f30c 100644 --- a/extra/unix/stat/stat.factor +++ b/extra/unix/stat/stat.factor @@ -1,5 +1,6 @@ -USING: kernel system combinators alien.syntax math vocabs.loader ; +USING: kernel system combinators alien.syntax alien.c-types + math io.unix.backend vocabs.loader ; IN: unix.stat @@ -55,11 +56,21 @@ FUNCTION: int fchmod ( int fd, mode_t mode ) ; FUNCTION: int mkdir ( char* path, mode_t mode ) ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +<< + os + { + { "linux" [ "unix.stat.linux" require ] } + { "macosx" [ "unix.stat.macosx" require ] } + [ drop ] + } + case +>> ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -{ - { [ linux? ] [ "unix.stat.linux" require ] } - { [ t ] [ ] } -} -cond +: check-status ( n -- ) io-error ; +: stat* ( pathname -- stat ) + "stat" dup >r + stat check-status + r> ;