basis/io/directories/unix/unix.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data alien.strings
   4 combinators continuations destructors fry io io.backend
   5 io.directories io.encodings.binary
   6 io.encodings.utf8 io.files io.pathnames io.files.types kernel
   7 math.bitwise sequences system unix unix.stat vocabs.loader
   8 classes.struct unix.ffi literals libc vocabs ;
   9 IN: io.directories.unix
  10
  11 CONSTANT: file-mode 0o0666
  12
  13 CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
  14
  15 M: unix touch-file ( path -- )
  16     normalize-path
  17     dup exists? [ touch ] [
  18         touch-mode file-mode open-file close-file
  19     ] if ;
  20
  21 M: unix move-file ( from to -- )
  22     [ normalize-path ] bi@ [ rename ] unix-system-call drop ;
  23
  24 M: unix delete-file ( path -- ) normalize-path unlink-file ;
  25
  26 M: unix make-directory ( path -- )
  27     normalize-path 0o777 [ mkdir ] unix-system-call drop ;
  28
  29 M: unix delete-directory ( path -- )
  30     normalize-path [ rmdir ] unix-system-call drop ;
  31
  32 M: unix copy-file ( from to -- )
  33     [ normalize-path ] bi@ call-next-method ;
  34
  35 : with-unix-directory ( path quot -- )
  36     [ opendir dup [ (io-error) ] unless ] dip
  37     dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
  38
  39 HOOK: find-next-file os ( DIR* -- byte-array )
  40
  41 M: unix find-next-file ( DIR* -- byte-array )
  42     dirent <struct>
  43     f void* <ref>
  44     0 set-errno
  45     [ readdir_r 0 = [ errno 0 = [ (io-error) ] unless ] unless ] 2keep
  46     void* deref [ drop f ] unless ;
  47
  48 : dirent-type>file-type ( ch -- type )
  49     {
  50         { DT_BLK  [ +block-device+ ] }
  51         { DT_CHR  [ +character-device+ ] }
  52         { DT_DIR  [ +directory+ ] }
  53         { DT_LNK  [ +symbolic-link+ ] }
  54         { DT_SOCK [ +socket+ ] }
  55         { DT_FIFO [ +fifo+ ] }
  56         { DT_REG  [ +regular-file+ ] }
  57         { DT_WHT  [ +whiteout+ ] }
  58         [ drop +unknown+ ]
  59     } case ;
  60
  61 M: unix >directory-entry ( byte-array -- directory-entry )
  62     {
  63         [ d_name>> underlying>> utf8 alien>string ]
  64         [ d_type>> dirent-type>file-type ]
  65     } cleave directory-entry boa ;
  66
  67 M: unix (directory-entries) ( path -- seq )
  68     [
  69         '[ _ find-next-file dup ]
  70         [ >directory-entry ]
  71         produce nip
  72     ] with-unix-directory ;
  73
  74 os linux? [ "io.directories.unix.linux" require ] when