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