Merge branch 'master' of git://factorcode.org/git/factor

Conflicts:

	extra/io/files/temporary/backend/backend.factor
	extra/io/files/temporary/temporary.factor
	extra/io/windows/files/temporary/temporary.factor

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"

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) ;

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

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

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 )

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 <writer> } " 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 } ;

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
+
+<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 )
+    [ drop random-ch ] "" map-as ;
+
+: unique-length ( -- n ) 10 ; inline
+: unique-retries ( -- n ) 10 ; inline
+PRIVATE>
+
+: 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

extra/io/unix/files/files.factor

@@ -2,7 +2,7 @@
 ! 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 ;
+       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 ;

extra/io/unix/files/temporary/temporary.factor

@@ -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
-    <writer> ;
-
-M: unix-io temporary-path ( -- path ) "/tmp" ;

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
+    <writer> ;
+
+M: unix-io temporary-path ( -- path ) "/tmp" ;

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
+io.unix.launcher io.unix.mmap io.backend io.unix.files.unique
-system vocabs.loader sequences ;
+combinators namespaces system vocabs.loader sequences ;
 
 "io.unix." os append require
 

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 <writer> ;
+
+M: windows-io temporary-path ( -- path )
+    "TEMP" os-env ;

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
+io.sockets.impl io.windows.files.unique windows.errors
-math namespaces sequences windows windows.kernel32
+strings io.streams.duplex kernel math namespaces sequences
-windows.shell32 windows.types windows.winsock splitting
+windows windows.kernel32 windows.shell32 windows.types
-continuations math.bitfields ;
+windows.winsock splitting continuations math.bitfields ;
 IN: io.windows
 
 TUPLE: windows-nt-io ;

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 ;

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
 
@@ -56,10 +57,20 @@ FUNCTION: int fchmod ( int fd, mode_t mode ) ;
 FUNCTION: int mkdir ( char* path, mode_t mode ) ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+<<
+  os
   {
-  { [ linux? ] [ "unix.stat.linux" require ] }
+    { "linux"  [ "unix.stat.linux"  require ] }
-  { [ t      ] [                           ] }
+    { "macosx" [ "unix.stat.macosx" require ] }
+    [ drop ]
   }
-cond
+  case
+>>
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: check-status ( n -- ) io-error ;
+
+: stat* ( pathname -- stat )
+  "stat" <c-object> dup >r
+    stat check-status
+  r> ;