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.strings combinators
   4 continuations destructors fry io io.backend io.backend.unix
   5 io.directories io.encodings.binary io.encodings.utf8 io.files
   6 io.pathnames io.files.types kernel math.bitwise sequences system
   7 unix unix.stat ;
   8 IN: io.directories.unix
   9
  10 : touch-mode ( -- n )
  11     { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
  12
  13 M: unix touch-file ( path -- )
  14     normalize-path
  15     dup exists? [ touch ] [
  16         touch-mode file-mode open-file close-file
  17     ] if ;
  18
  19 M: unix move-file ( from to -- )
  20     [ normalize-path ] bi@ rename io-error ;
  21
  22 M: unix delete-file ( path -- ) normalize-path unlink-file ;
  23
  24 M: unix make-directory ( path -- )
  25     normalize-path OCT: 777 mkdir io-error ;
  26
  27 M: unix delete-directory ( path -- )
  28     normalize-path rmdir io-error ;
  29
  30 : (copy-file) ( from to -- )
  31     dup parent-directory make-directories
  32     binary <file-writer> [
  33         swap binary <file-reader> [
  34             swap stream-copy
  35         ] with-disposal
  36     ] with-disposal ;
  37
  38 M: unix copy-file ( from to -- )
  39     [ normalize-path ] bi@ (copy-file) ;
  40
  41 : with-unix-directory ( path quot -- )
  42     [ opendir dup [ (io-error) ] unless ] dip
  43     dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
  44
  45 : find-next-file ( DIR* -- byte-array )
  46     "dirent" <c-object>
  47     f <void*>
  48     [ readdir_r 0 = [ (io-error) ] unless ] 2keep
  49     *void* [ drop f ] unless ;
  50
  51 : dirent-type>file-type ( ch -- type )
  52     {
  53         { DT_BLK  [ +block-device+ ] }
  54         { DT_CHR  [ +character-device+ ] }
  55         { DT_DIR  [ +directory+ ] }
  56         { DT_LNK  [ +symbolic-link+ ] }
  57         { DT_SOCK [ +socket+ ] }
  58         { DT_FIFO [ +fifo+ ] }
  59         { DT_REG  [ +regular-file+ ] }
  60         { DT_WHT  [ +whiteout+ ] }
  61         [ drop +unknown+ ]
  62     } case ;
  63
  64 M: unix >directory-entry ( byte-array -- directory-entry )
  65     [ dirent-d_name utf8 alien>string ]
  66     [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ;
  67
  68 M: unix (directory-entries) ( path -- seq )
  69     [
  70         '[ _ find-next-file dup ]
  71         [ >directory-entry ]
  72         [ drop ] produce
  73     ] with-unix-directory ;