From c9b73f062b2266466ea8d250b27a49e82ac6d9cb Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 28 Feb 2008 23:46:27 -0600
Subject: [PATCH] Implement file-info
---
core/io/files/files.factor | 16 +++++++++++++++-
extra/io/unix/files/files.factor | 25 +++++++++++++++++++++++--
extra/unix/stat/macosx/macosx.factor | 4 ++++
extra/unix/stat/stat.factor | 23 +++++++++++++++++------
4 files changed, 59 insertions(+), 9 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 85f0621443..e20437fa85 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/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/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" <c-object> dup >r
+ stat check-status
+ r> ;