basis/tools/files/unix/unix.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators kernel system unicode.case io.files
   4 io.files.info io.files.info.unix tools.files generalizations
   5 strings arrays sequences math.parser unix.groups unix.users
   6 tools.files.private unix.stat math ;
   7 IN: tools.files.unix
   8
   9 <PRIVATE
  10
  11 : unix-execute>string ( str bools -- str' )
  12     swap {
  13         { { t t } [ >lower ] }
  14         { { t f } [ >upper ] }
  15         { { f t } [ drop "x" ] }
  16         [ 2drop "-" ]
  17     } case ;
  18
  19 : permissions-string ( permissions -- str )
  20     {
  21         [ type>> file-type>ch 1string ]
  22         [ user-read? read>string ]
  23         [ user-write? write>string ]
  24         [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ]
  25         [ group-read? read>string ]
  26         [ group-write? write>string ]
  27         [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ]
  28         [ other-read? read>string ]
  29         [ other-write? write>string ]
  30         [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ]
  31     } cleave 10 narray concat ;
  32
  33 : mode>symbol ( mode -- ch )
  34     S_IFMT bitand
  35     {
  36         { [ dup S_IFDIR = ] [ drop "/" ] }
  37         { [ dup S_IFIFO = ] [ drop "|" ] }
  38         { [ dup any-execute? ] [ drop "*" ] }
  39         { [ dup S_IFLNK = ] [ drop "@" ] }
  40         { [ dup S_IFWHT = ] [ drop "%" ] }
  41         { [ dup S_IFSOCK = ] [ drop "=" ] }
  42         { [ t ] [ drop "" ] }
  43     } cond ;
  44
  45 M: unix (directory.) ( path -- lines )
  46     [ [
  47         [
  48             dup file-info
  49             {
  50                 [ permissions-string ]
  51                 [ nlink>> number>string 3 CHAR: \s pad-left ]
  52                 ! [ uid>> ]
  53                 ! [ gid>> ]
  54                 [ size>> number>string 15 CHAR: \s pad-left ]
  55                 [ modified>> ls-timestamp ]
  56             } cleave 4 narray swap suffix " " join
  57         ] map
  58     ] with-group-cache ] with-user-cache ;
  59
  60 PRIVATE>