basis/tools/files/unix/unix.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators combinators.smart
   4 io.files.info.unix kernel math math.order math.parser sequences
   5 strings system tools.files tools.files.private unicode
   6 unix.groups unix.stat unix.users ;
   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         {
  22             [ type>> file-type>ch 1string ]
  23             [ user-read? read>string ]
  24             [ user-write? write>string ]
  25             [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ]
  26             [ group-read? read>string ]
  27             [ group-write? write>string ]
  28             [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ]
  29             [ other-read? read>string ]
  30             [ other-write? write>string ]
  31             [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ]
  32         } cleave
  33     ] output>array concat ;
  34
  35 : mode>symbol ( mode -- ch )
  36     S_IFMT bitand
  37     {
  38         { [ dup S_IFDIR = ] [ drop "/" ] }
  39         { [ dup S_IFIFO = ] [ drop "|" ] }
  40         { [ dup any-execute? ] [ drop "*" ] }
  41         { [ dup S_IFLNK = ] [ drop "@" ] }
  42         { [ dup S_IFWHT = ] [ drop "%" ] }
  43         { [ dup S_IFSOCK = ] [ drop "=" ] }
  44         [ drop "" ]
  45     } cond ;
  46
  47 M: unix (directory.)
  48     <listing-tool>
  49         {
  50             +permissions+ +nlinks+ +user+ +group+
  51             +file-size+ +file-date+ +file-name+
  52         } >>specs
  53         { { directory-entry>> name>> <=> } } >>sort
  54     [ [ list-files ] with-group-cache ] with-user-cache ;
  55
  56 M: unix file-spec>string
  57     {
  58         { +file-name/type+ [
  59             directory-entry>> [ name>> ] [ file-type>trailing ] bi append
  60         ] }
  61         { +permissions+ [ file-info>> permissions-string ] }
  62         { +nlinks+ [ file-info>> nlink>> number>string ] }
  63         { +user+ [ file-info>> uid>> user-name ] }
  64         { +group+ [ file-info>> gid>> group-name ] }
  65         { +uid+ [ file-info>> uid>> number>string ] }
  66         { +gid+ [ file-info>> gid>> number>string ] }
  67         [ call-next-method ]
  68     } case ;
  69
  70 PRIVATE>