basis/io/directories/unix/unix.factor

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