tabdata/td-ls

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 td-ls - ls(1)-like file list but more machine-parseable
   8
   9 =head1 SYNOPSIS
  10
  11 td-ls [I<OPTIONS>] [I<PATHS>] [-- I<FIND-OPTIONS>]
  12
  13 =head1 OPTIONS, ls(1)-compatible
  14
  15 =over 4
  16
  17 =item -A, --almost-all
  18
  19 =item -g
  20
  21 =item -G, --no-group
  22
  23 =item -i, --inode
  24
  25 =item -l (implied)
  26
  27 =item -n, --numeric-uid-gid
  28
  29 =item -o
  30
  31 =item --time=[atime, access, use, ctime, status, birth, creation, mtime, modification]
  32
  33 =item -R, --recursive
  34
  35 =item -U (implied, pipe to sort(1) if you want)
  36
  37 =back
  38
  39 =head1 OPTIONS, not ls(1)-compatible
  40
  41 =over 4
  42
  43 =item --devnum
  44
  45 =item -H, --no-header
  46
  47 =item --no-symlink-target
  48
  49 =item --add-field I<FIELD-NAME>
  50
  51 Add extra fields by name.
  52 See field names by B<--help-field-names> option.
  53 May be added multiple times.
  54
  55 =item --add-field-macro I<FORMAT>
  56
  57 Add extra fields by find(1)-style format specification.
  58 For valid I<FORMAT>s, see B<-printf> section in find(1).
  59 May be added multiple times.
  60 Putting C<\\0> (backslash-zero) in I<FORMAT> screws up the output; don't do that.
  61
  62 =item --help-field-names
  63
  64 Show valid field names to be used for B<--add-field> option.
  65
  66 =back
  67
  68 =head1 DESCRIPTION
  69
  70 Columns are similar to good old ls(1):
  71 PERMS (symbolic representation),
  72 LINKS,
  73 USERNAME (USERID if B<-n> option is given),
  74 GROUPNAME (GROUPID if B<-n> option is given),
  75 SIZE (in bytes),
  76 time field is either ATIME, CTIME, or default MTIME (in full-iso format),
  77 BASENAME (or RELPATH in B<--recursive> mode),
  78 and SYMLINKTARGET (unless B<--no-symlink-target> option is given).
  79
  80 Column names are a bit different than td-trans-ls(1) produces, but this is intentional,
  81 because fields by these 2 tools have slightly different meaning.
  82 td-trans-ls(1) is less smart because it just transforms ls(1)'s output and
  83 does not always know what is in the input exactly; while td-ls(1) itself controls
  84 what data goes to the output.
  85
  86 No color support.
  87
  88 =head1 FORMAT
  89
  90 Output format is tabular data: a table, in which fields are delimited by TAB
  91 and records by newline (LF).
  92
  93 Meta chars may occur in some fields (path, filename, symlink target, etc),
  94 these are escaped this (perl-compatible) way:
  95
  96  | Raw char  | Substituted to |
  97  |-----------|----------------|
  98  | ESC       | \e             |
  99  | TAB       | \t             |
 100  | LF        | \n             |
 101  | CR        | \r             |
 102  | Backslash | \\             |
 103
 104 Other control chars (charcode below 32 in ASCII)
 105 including NUL, vertical-tab, and form-feed are left as-is.
 106
 107 =head1 ENVIRONMENT
 108
 109 =over 4
 110
 111 =item TIME_STYLE
 112
 113 B<TIME_STYLE> is ignored as well as I<--time-style> option.
 114 Always show date-time in C<%F %T %z> strftime(3) format!
 115 It's simply the most superior.
 116 Equivalent to B<TIME_STYLE=full-iso>.
 117
 118 =back
 119
 120 =head1 SEE ALSO
 121
 122 td-select(1), td-filter(1), td-trans-ls(1)
 123
 124 =cut
 125
 126
 127 use Getopt::Long qw/:config no_ignore_case bundling no_getopt_compat/;
 128 use Pod::Usage;
 129 use Data::Dumper;
 130 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
 131 $TabdataCommonSkipGetopt = 1;
 132 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
 133
 134
 135 %field_macro = (qw/devnum %D inode %i perms %M links %n username %u userid %U groupname %g groupid %G size %s
 136         basename %f relpath %p dirpath %h symlinktarget %l
 137         depth %d fstype %F perms-octal %m ftype %y ltype %Y/,
 138         'atime', '%AF %AT %Az',
 139         'btime', '%BF %BT %Bz',
 140         'ctime', '%CF %CT %Cz',
 141         'mtime', '%TF %TT %Tz');
 142
 143 %time_types = qw/atime a access a use a ctime c status c birth b creation b mtime m modification m/;
 144
 145
 146 @depthopts = qw/-mindepth 1 -maxdepth 1/;
 147 $show_inode = 0;
 148 $show_devnum = 0;
 149 $uidgid_numeric = 0;
 150 $hide_user = 0;
 151 $hide_group = 0;
 152 $recursive = 0;
 153 $show_symlink_target = 1;
 154 $show_header = 1;
 155 $time_type = 'm';
 156 @extra_fields = ();
 157 @extra_macros = ();
 158 %ignore_name = ('dotfiles'=>'.*',);
 159
 160 GetOptions(
 161         'A|almost-all' => sub{ delete $ignore_name{'dotfiles'}; },
 162         'l' => sub{},
 163         'i|inode' => \$show_inode,
 164         'devnum' => \$show_devnum,
 165         'n|numeric-uid-gid' => \$uidgid_numeric,
 166         'G|no-group' => \$hide_group,
 167         'g' => \$hide_user,
 168         'o' => \$hide_group,
 169         'symlink-target!' => \$show_symlink_target,
 170         'R|recursive' => \$recursive,
 171         'header!' => \$show_header,
 172         'c' => sub{ $time_type = 'c'; },
 173         'u' => sub{ $time_type = 'a'; },
 174         'time=s' => sub{ $time_type = $time_types{$_[1]} or die "$0: unknown time type: $_[0]\n"; },
 175         'add-field=s@' => \@extra_fields,
 176         'add-field-macro=s@' => \@extra_macros,
 177         'help|?' => sub{ pod2usage(-exitval=>0, -verbose=>99); },
 178         'help-field-names' => sub{ print "$_\n" for sort keys %field_macro; exit 0; },
 179 ) or pod2usage(-exitval=>2, -verbose=>99);
 180
 181
 182 @depthopts = () if $recursive;
 183 @fields = ();
 184
 185 push @fields, 'devnum' if $show_devnum;
 186 push @fields, 'inode' if $show_inode;
 187 push @fields, 'perms', 'links';
 188 push @fields, ($uidgid_numeric ? 'uid' : 'username') if not $hide_user;
 189 push @fields, ($uidgid_numeric ? 'gid' : 'groupname') if not $hide_group;
 190 push @fields, 'size';
 191 push @fields, $time_type.'time';
 192 push @fields, ($recursive ? 'relpath' : 'basename');
 193 push @fields, 'symlinktarget' if $show_symlink_target;
 194 push @fields, @extra_fields;
 195
 196 @field_macros = ();
 197 push @field_macros, map {$field_macro{$_}} @fields;
 198 push @field_macros, @extra_macros;
 199
 200 $FS = "\t";
 201 $RS = "\n";
 202
 203 if($show_header)
 204 {
 205         @header = ();
 206         push @header, map {uc} @fields;
 207         push @header, @extra_macros;
 208         print join($FS, @header).$RS;
 209 }
 210
 211 # since we can't ask find(1) to escape meta chars properly
 212 # (replaces all LF/TAB/ESC/… uniformly to "?" if output is a terminal, and
 213 # does not escapes anything if output is pipe or file),
 214 # and there probably will be data fields which may contain arbitrary bytes,
 215 # eg. paths, file names, link targets, etc,
 216 # we delimit fields by NUL
 217 # (NUL hopefully won't be in them).
 218 # Then escape them properly
 219 # and output in tabular data format to the user.
 220
 221 open $fh, '-|:utf8', 'find', @ARGV, @depthopts,
 222         (map {('!', '-name', $_)} values %ignore_name),
 223         '-printf', join("\\0", @field_macros)."\\0"
 224 or die "$0: $!\n";
 225
 226 $/ = "\0";
 227
 228 RECORD:
 229 while(1)
 230 {
 231         FIELD:
 232         for my $colnum (0..$#field_macros)
 233         {
 234                 my $arbitrary_data = <$fh>;
 235                 last RECORD if $arbitrary_data eq '';
 236                 chomp $arbitrary_data;
 237                 my $tabular_data = escape_tabdata($arbitrary_data);
 238                 print $FS if $colnum > 0;
 239                 print $tabular_data;
 240         }
 241         print $RS;
 242 }