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

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
db4
Doug Coleman 2008-02-29 17:12:50 -06:00
parent 2753b2442a b7f9aac210
commit 71af041083
15 changed files with 193 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
core/io/files/files-docs.factor
View File

@ -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"

16
core/io/files/files.factor
View File

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

2
extra/combinators/lib/lib.factor
View File

@ -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

5
extra/db/sqlite/sqlite.factor
View File

@ -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

5
extra/io/files/unique/backend/backend.factor Normal file
View File

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

50
extra/io/files/unique/unique-docs.factor Normal file
View File

@ -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 } ;

48
extra/io/files/unique/unique.factor Normal file
View File

@ -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

25
extra/io/unix/files/files.factor
View File

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

12
extra/io/unix/files/temporary/temporary.factor
View File

@ -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" ;

12
extra/io/unix/files/unique/unique.factor Normal file
View File

@ -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" ;

4
extra/io/unix/unix.factor
View File

@ -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

8
extra/io/windows/files/unique/unique.factor Normal file
View File

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

8
extra/io/windows/windows.factor
View File

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

4
extra/unix/stat/macosx/macosx.factor
View File

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

23
extra/unix/stat/stat.factor
View File

@ -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" <c-object> dup >r
stat check-status
r> ;