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 generalizations
   5 strings arrays sequences math.parser unix.groups unix.users
   6 tools.files.private unix.stat math fry macros combinators.smart
   7 io.files.info.unix io tools.files math.order prettyprint ;
   8 IN: tools.files.unix
   9
  10 <PRIVATE
  11
  12 : unix-execute>string ( str bools -- str' )
  13     swap {
  14         { { t t } [ >lower ] }
  15         { { t f } [ >upper ] }
  16         { { f t } [ drop "x" ] }
  17         [ 2drop "-" ]
  18     } case ;
  19
  20 : permissions-string ( permissions -- str )
  21     [
  22         {
  23             [ type>> file-type>ch 1string ]
  24             [ user-read? read>string ]
  25             [ user-write? write>string ]
  26             [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ]
  27             [ group-read? read>string ]
  28             [ group-write? write>string ]
  29             [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ]
  30             [ other-read? read>string ]
  31             [ other-write? write>string ]
  32             [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ]
  33         } cleave
  34     ] output>array concat ;
  35
  36 : mode>symbol ( mode -- ch )
  37     S_IFMT bitand
  38     {
  39         { [ dup S_IFDIR = ] [ drop "/" ] }
  40         { [ dup S_IFIFO = ] [ drop "|" ] }
  41         { [ dup any-execute? ] [ drop "*" ] }
  42         { [ dup S_IFLNK = ] [ drop "@" ] }
  43         { [ dup S_IFWHT = ] [ drop "%" ] }
  44         { [ dup S_IFSOCK = ] [ drop "=" ] }
  45         { [ t ] [ drop "" ] }
  46     } cond ;
  47
  48 M: unix (directory.) ( path -- lines )
  49     <listing-tool>
  50         { permissions nlinks user group file-size file-datetime file-name } >>specs
  51         { { directory-entry>> name>> <=> } } >>sort
  52     [ [ list-files ] with-group-cache ] with-user-cache ;
  53
  54 M: unix file-spec>string ( file-listing spec -- string )
  55     {
  56         { file-name/type [
  57             directory-entry>> [ name>> ] [ file-type>trailing ] bi append
  58         ] }
  59         { permissions [ file-info>> permissions-string ] }
  60         { nlinks [ file-info>> nlink>> number>string ] }
  61         { file-size [ file-info>> size>> number>string ] }
  62         { user [ file-info>> uid>> user-name ] }
  63         { group [ file-info>> gid>> group-name ] }
  64         { uid [ file-info>> uid>> number>string ] }
  65         { gid [ file-info>> gid>> number>string ] }
  66         { file-datetime [ file-info>> modified>> listing-timestamp ] }
  67         { file-time [ file-info>> modified>> listing-time ] }
  68         [ call-next-method ]
  69     } case ;
  70
  71 PRIVATE>