]> git.treefish.org Git - fex.git/blob - bin/l
Original release 20160328
[fex.git] / bin / l
1 #!/usr/bin/perl -w
2 #
3 # l / ll / lf / llf -  better replacement of the classic ls command
4 #
5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
6 #
7 # Perl Artistic License
8
9 use Cwd qw'abs_path';
10 use File::Basename;
11 use Getopt::Std;
12
13 # the name of the game
14 $0 =~ s:.*/::;
15
16 $ENV{LC_CTYPE} = 'C';
17
18 # unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'};
19
20 @ARGV = grep { chomp } <STDIN> if "@ARGV" eq '-';
21
22 # parse CLI arguments
23 $opt_l = $opt_i = $opt_t = $opt_s = $opt_a = $opt_r = $opt_d = $opt_n = 0;
24 $opt_L = $opt_N = $opt_c = $opt_u = $opt_S = $opt_R = $opt_z = $opt_h = 0;
25 $opt_U = $opt_x = $opt_E = 0;
26 ${'opt_*'} = 0;
27 $opt_m = $opt_f = $opt_F = $opt_D = '';
28 getopts('hdnlLNitcuarsxUSREz*m:f:D:F:') or usage(1);
29 usage(0) if $opt_h;
30 $opt_z = 1 unless $opt_R;
31 $opt_l = 1                            if $0 eq 'll';
32 $opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll';
33 &examples if $opt_E;
34 if ($0 eq 'lf' or $0 eq 'llf') {
35   $opt_F ||= shift or usage(1);
36   $opt_R ||= scalar(@ARGV) || ($opt_F eq '.');
37   $opt_l ||= $0 eq 'llf';
38 }
39
40 $postsort = $opt_t||$opt_s;
41 $postproc = $postsort||$opt_z;
42
43 # mark for squeeze operation
44 $z = $opt_z ? "\0" : '';
45
46 # default sorting methode
47 if    ($opt_U) { $lcsort = sub { return @_ } }
48 elsif ($opt_r) { $lcsort = sub { sort { lc $b cmp lc $a } @_ } }
49 else           { $lcsort = sub { sort { lc $a cmp lc $b } @_ } }
50
51 # default: list only files not beginning with a dot
52 unless ($opt_m) {
53   if ($opt_a) { $opt_m = '.' }
54   else        { $opt_m = '^[^\.]' }
55 }
56
57 $older = $newer = 0;
58
59 if ($opt_D) {
60   if ($opt_D =~ /:(\d+)([mhd])/) {
61     $older = $1;
62     my $z = $2 || 's';
63     if    ($z =~ /m/) { $older *= 60 }
64     elsif ($z =~ /h/) { $older *= 60*60 }
65     elsif ($z =~ /d/) { $older *= 60*60*24 }
66   } elsif ($opt_D =~ /:(\d\d\d\d-\d\d-\d\d)$/) {
67     $older = $1;
68   }
69   if ($opt_D =~ /(\d+)([mhd]):/) {
70     $newer = $1;
71     my $z = $2 || 's';
72     if    ($z =~ /m/) { $newer *= 60 }
73     elsif ($z =~ /h/) { $newer *= 60*60 }
74     elsif ($z =~ /d/) { $newer *= 60*60*24 }
75   } elsif ($opt_D =~ /^(\d\d\d\d-\d\d-\d\d):/) {
76     $newer = $1;
77   }
78 }
79
80 # preselect date field number
81 if    ($opt_c) { $sdf = 'c' }
82 elsif ($opt_u) { $sdf = 'a' }
83 else           { $sdf = 'm' }
84
85 # any arguments?
86 if (@ARGV) { @ARGV = &$lcsort(@ARGV) }
87 else       { @ARGV = &getfiles('.') }
88
89 # build files list
90 &collect(@ARGV);
91
92 # post process files list?
93 # remark: if no postprocessing, files list has been already printed in list()
94 if (@LIST && $postproc) {
95
96   # on -t or -s option sort list on date or size
97   # and then strip of leading sorting pre-string
98   @LIST = grep { s/.{21}// } reverse sort @LIST if $postsort;
99
100   # squeeze size field (= remove unnecessary spaces)
101   if ($opt_z and not $opt_f) {
102     $opt_z = '%'.$opt_z.'s ';
103     @LIST = grep { s/\0 *([,\d\.\-]+) /sprintf($opt_z,$1)/e } @LIST;
104   }
105
106   @LIST = reverse @LIST if $opt_r;
107
108   if (not ($opt_t or $opt_U) and grep /^d[rR-][wW-][xX-]/,@LIST) {
109     foreach (@LIST) { print if /^d/ }
110     foreach (@LIST) { print unless /^d/ }
111   } else {
112     print @LIST;
113   }
114 }
115
116 # print statistics summary?
117 if ($opt_S && $SS) {
118   print "$SS file(s):";
119   printf " r=%d (%s Bytes)",$SS{'-'},&d3($Ss) if $SS{'-'};
120   delete $SS{'-'};
121   foreach my $type (qw(l d c b p s ?)) {
122     printf " %s=%d",$type,$SS{$type} if $SS{$type};
123     delete $SS{$type};
124   }
125   foreach my $type (keys %SS) { printf " %s=%d",$type,$SS{$type} }
126   print "\n";
127 }
128
129 exit ($found ? 0 : 1);
130
131
132 # collect files and build file lists
133 #
134 # INPUT: filenames
135 #
136 # GLOBAL: @LIST
137 sub collect {
138   my @files = @_;
139   my $f;
140
141   # loop over all argument files/directories
142   foreach $f (@files) {
143
144     # skip jed and emacs backup files
145     # next if $f =~ /~$/ and not $opt_a and not $opt_l;
146
147     # recursive?
148     if ($opt_R) {
149
150       # list single file
151       if ($opt_L) {
152         unless (-e $f) {
153           warn "$0: dangling symlink $f\n";
154           next;
155         }
156         $f = abs_path($f);
157       }
158       list($f);
159
160       # traverse real subdirs
161       if (-d $f and not -l $f) {
162         $f =~ s:/*$:/:;
163         # skip other file systems on -x
164         if ($opt_x) {
165           my @pd = stat(dirname($f));
166           my @sd = stat($f);
167           next if $pd[0] ne $sd[0];
168         }
169         collect(getfiles($f));
170       }
171
172     } else {
173
174       # suppress trailing / on -d option
175       $f =~ s:/$:: if $opt_d;
176
177       # on trailing / list subdirs, too
178       if ($f =~ m:/$:) { &list(&getfiles($f)) }
179       elsif ($f eq '') { &list('/') }
180       else {
181         if ($opt_L) {
182           unless (-e $f) {
183             warn "$0: dangling symlink $f\n";
184             next;
185           }
186           $f = abs_path($f);
187         }
188         list($f);
189       }
190
191     }
192   }
193 }
194
195
196 # list file(s)
197 #
198 # INPUT: filenames
199 #
200 # GLOBAL: @LIST (filenames-list)
201 sub list {
202   my @files = @_;
203   my ($file,$line,$linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
204   my ($day);
205
206   foreach $file (@files) {
207
208     next if $opt_F and not fmatch($file);
209     next if $opt_N and (not -f $file or -l $file);
210
211     # get file information
212     # if ($opt_L and stat $file or not $opt_L and lstat $file) {
213     if (lstat $file) {
214       ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates) = &info($file);
215     } elsif ($! eq "Permission denied") {
216       $linkname = $file;
217       $inode = $links = $size = $uid = $gid = '?';
218       $mode = $opt_l ? '?---------' : '?---';
219       $date = '????-??-?? ??:??:??';
220       %dates = ('m' => 0, 'a' => 0, 'c' => 0);
221     } else {
222       warn "$0: ".quote($file)." - $!\n";
223       next;
224     }
225
226     $day = $date;
227     $day =~ s/\s.*//;
228
229     if ($older) {
230       next if $older =~ /-/ and $day gt $older;
231       next if $older !~ /-/ and $dates{m} > time-$older;
232     }
233     if ($newer) {
234       next if $newer =~ /-/ and $day lt $newer;
235       next if $newer !~ /-/ and $dates{m} < time-$newer;
236     }
237
238     if (defined $linkname) {
239
240       # prepend sorting string
241       $line = '';
242       $line = sprintf '%21s',$date if $opt_t;
243       $line = sprintf '%21s',$size if $opt_s;
244
245       unless ($opt_n) {
246         $uid = substr($uid,0,8);
247         $gid = substr($gid,0,8);
248       }
249
250       # user defined format?
251       if ($opt_f) {
252         foreach my $i (split '',$opt_f) {
253           if ($opt_n) {
254             $i =~ tr/AD/ad/;
255             if    ($i eq 'm') { $line .= sprintf '%06o ',  $mode }
256             elsif ($i eq 'u') { $line .= sprintf '%6d ',   $uid }
257             elsif ($i eq 'g') { $line .= sprintf '%6d ',   $gid }
258             elsif ($i eq 's') { $line .= sprintf "$z%16s ",$size }
259             elsif ($i eq 'l') { $line .= sprintf '%3s ',   $links }
260             elsif ($i eq 'i') { $line .= sprintf '%14s ',  $inode }
261             elsif ($i eq 'd') { $line .= sprintf '%10s ',  $date }
262             elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ',
263                                          $dates{'a'},$dates{'m'},$dates{'c'} }
264           } else {
265             if    ($i eq 'm') { $line .= $mode.' ' }
266             elsif ($i eq 'u') { $line .= sprintf '%-8s ',  $uid }
267             elsif ($i eq 'g') { $line .= sprintf '%-8s ',  $gid }
268             elsif ($i eq 's') { $line .= sprintf "$z%19s ",$size }
269             elsif ($i eq 'l') { $line .= sprintf '%3s ',   $links }
270             elsif ($i eq 'i') { $line .= sprintf '%14s ',  $inode }
271             elsif ($i eq 'd') { $line .= $date.' ' }
272             elsif ($i eq 'D') { $line .= $date.' ' }
273             elsif ($i eq 'a') { $line .= &isodate($dates{'a'}).' '.
274                                          &isodate($dates{'m'}).' '.
275                                          &isodate($dates{'c'}).' ' }
276             elsif ($i eq 'A') { $line .= &isodate($dates{'a'}).' '.
277                                          &isodate($dates{'m'}).' '.
278                                          &isodate($dates{'c'}).' ' }
279           }
280         }
281
282       # predefined formats
283       } else {
284
285         if ($opt_n) {
286           if ($opt_l) { $line .= sprintf "%06o %6d %6d $z%15s %10d ",
287                                          $mode,$uid,$gid,$size,$date }
288           else        { $line .= sprintf "%06o $z%15s %10d ",
289                                          $mode,$size,$date }
290         } else {
291           if ($opt_l) { $line .= sprintf "%s %-8s %-8s $z%19s %s ",
292                                          $mode,$uid,$gid,$size,$date }
293           else        { $line .= sprintf "%s $z%19s %s ",
294                                          $mode,$size,substr($date,0,-3) }
295         }
296
297         if ($opt_i)   { $line .= sprintf '%3s %10s ',$links,$inode }
298       }
299
300       $line .= $linkname."\n";
301
302       if ($postproc) {
303         push @LIST,$line;
304       } else {
305         $line =~ s/\0//;
306         print $line;
307       }
308       $found++;
309
310     } else {
311       lstat $file;
312       warn "$0: cannot get dir-info for ".quote($file)." - $!\n";
313     }
314
315   }
316 }
317
318 # get file information
319 #
320 # INPUT: file name
321 #
322 # OUTPUT: filename with linkname, inode, hard link count, size, mode string,
323 #         UID, GID, isodate
324 sub info {
325   my $file = shift;
326   my ($linkname,$links,$mode,$bmode,$uid,$gid,$date,%dates,@stat);
327   my $size = '-';
328   my $inode = '?';
329   my @rwx = qw/--- --x -w- -wx r-- r-x rw- rwx/;
330   my $type;
331
332   if ($opt_L) { @stat = stat $file }
333   else        { @stat = lstat $file }
334
335   if (@stat) {
336
337     $inode = $stat[1];
338     $bmode = $stat[2];
339     $links = $stat[3];
340     %dates = ('m' => $stat[9],
341               'a' => $stat[8],
342               'c' => $stat[10]);
343
344     if ($opt_n) {
345       $uid  = $stat[4];
346       $gid  = $stat[5];
347       $date = $dates{$sdf};
348     } else {
349       $uid  = getpwuid($stat[4]) || $stat[4];
350       $gid  = getgrgid($stat[5]) || $stat[5];
351       $date = &isodate($dates{$sdf});
352     }
353
354     if    (-f _)            { $type = '-'; $size = $stat[7]; }
355     elsif (!$opt_L && -l _) { $type = 'l'; }
356     elsif (-d _)            { $type = 'd'; }
357     elsif (-c _)            { $type = 'c'; $size = &nodes($stat[6]); }
358     elsif (-b _)            { $type = 'b'; $size = &nodes($stat[6]); }
359     elsif (-p _)            { $type = 'p'; }
360     elsif (-S _)            { $type = 's'; }
361     else                    { $type = '?'; }
362
363     if ($opt_n) {
364       $mode = $stat[2];
365       $size = $stat[7] if $size eq '-';
366     } else {
367       if ($opt_l) {
368         $mode = $rwx[$bmode & 7];
369         $bmode >>= 3;
370         $mode = $rwx[$bmode & 7] . $mode;
371         $bmode >>= 3;
372         $mode = $rwx[$bmode & 7] . $mode;
373         substr($mode,2,1) =~ tr/-x/Ss/ if -u _;
374         substr($mode,5,1) =~ tr/-x/Ss/ if -g _;
375         substr($mode,8,1) =~ tr/-x/Tt/ if -k _;
376         $mode = $type.$mode;
377       } else {
378         # with short list display only effektive file access modes
379         $mode = $type
380                 . (-r _ ? 'R' : '-')
381                 . (-w _ ? 'W' : '-')
382                 . (-x _ ? 'X' : '-');
383         substr($mode,2,1) =~ tr/-x/Ss/ if -u _ or -g _;
384         substr($mode,3,1) =~ tr/-x/Tt/ if -k _;
385       }
386     }
387
388   # fall back to ls command if perl lstat failed
389   } else {
390     if ($opt_L) {
391       return;
392     } else {
393       ($mode,$links,$uid,$gid,$size) = split /\s+/,`ls -ld $file 2>/dev/null`;
394       return undef unless defined $mode;
395       $type = substr($mode,0,1);
396       # for (my $i=0;$i<3;$i++) { push @dates,'????-??-?? ??:??:??' }
397       # $date = `gfind $dir -maxdepth 1 -name $file -printf '%Ty-%Tm-%Td %TT\n'`;
398     }
399   }
400
401   # summarize statistics
402   if ($opt_S) {
403     $SS++;
404     $SS{$type}++;
405     $Ss += $size if $type eq '-';
406   }
407
408   $size = &d3($size);
409
410   # determine longest size field
411   if ($opt_z) {
412     my $x = length $size;
413     $opt_z = $x if $x>$opt_z;
414   }
415   $linkname = ${'opt_*'} ? $file : quote($file) ;
416   if ($type eq 'l' and $opt_f !~ /n/) {
417     my $link = readlink($file);
418     if (defined $link) {
419       $linkname .= ' -> ' . (${'opt_*'} ? $link : quote($link));
420     }
421   }
422   $mode =~ s/\+$//;
423   #$mode .= ' ' unless $mode =~ /\+$/;
424
425   return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
426 }
427
428
429 # reformat integer into 3-digit doted format
430 # (when non-numerical mode is set)
431 #
432 # INPUT: integer or '-'
433 #
434 # OUTPUT: d3-string
435 sub d3 {
436   local $_ = shift;
437   if ($opt_n) { s/-/0/ }
438   else        { while (s/(\d)(\d\d\d\b)/$1,$2/) {} }
439   return $_;
440 }
441
442
443 # get all files matching pattern $opt_m
444 #
445 # INPUT: directory to scan
446 #
447 # OUTPUT: files which match (sorted, directories first)
448 sub getfiles {
449   my $dir = shift;
450   my @files = ();
451   my @dirs = ();
452   my $f;
453
454   if (opendir D,$dir) {
455     $dir = '' if $dir eq '.';
456     while (defined($f = readdir D)) {
457
458       # skip . and .. pseudo-subdirs
459       next if $f =~ m:(^|/)\.\.?/*$:;
460       # skip ONTAP snapshot dir
461       next if $f =~ m:(^|/)\.snapshot/*$:;
462
463
464       # skip jed and emacs backup files
465       # next if $f =~ /~$/ and not $opt_a and not $opt_l;
466
467       if ($f =~ /$opt_m/) {
468         my $x = $dir.$f;
469         if (not -l $x and -d $x and not ($opt_R or $postsort or $opt_U)) {
470           push @dirs,$x;
471         } else {
472           push @files,$x;
473         }
474       }
475     }
476     closedir D;
477     unless ($postsort) {
478       @files = &$lcsort(@files);
479       @dirs  = &$lcsort(@dirs);
480     }
481   } else {
482     warn "$0: cannot read $dir : $!\n";
483   }
484
485   return (@dirs,@files);
486 }
487
488
489 # reformat integer to string node
490 #
491 # INPUT: integer node
492 #
493 # OUTPUT: string node
494 sub nodes {
495   my $rdev = shift;
496   return sprintf("%03d,%03d", ($rdev >> 8) & 255, $rdev & 255);
497 }
498
499
500 # reformat timetick to ISO date string
501 #
502 # INPUT: timetick
503 #
504 # OUTPUT: ISO date string
505 sub isodate {
506   my @d = localtime shift;
507   return sprintf('%d-%02d-%02d %02d:%02d:%02d',
508                  $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
509 }
510
511
512 # quote file name to printable name and escape shell meta chars
513 #
514 # INPUT: original file name
515 #
516 # OUTPUT: printable file name
517 sub quote {
518   local $_ = shift;
519   my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};';
520
521   unless (defined $_) {
522     die "@_";
523     @x = caller;
524     die "@x";
525   }
526   if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) {
527     s/([$mc])/\\$1/g;
528     s/^~/\\~/;
529 # } elsif (/[$mc]/ or -d and /:/) {
530   } elsif (/[$mc]/) {
531     $_ = "'$_'";
532   }
533   return $_;
534 }
535
536
537 sub fmatch {
538   my $file = shift;
539   my $link = readlink($file)||'';
540
541   return $file if basename($file) =~ /$opt_F/i;
542   return $link if basename($link) =~ /$opt_F/i;
543 }
544
545
546 sub usage {
547   my $status = shift;
548   my $opts = '[-lastcuidnrzLRxNS*] [-f format] [-D X:Y]';
549   local *OUT = $status ? *STDERR : *STDOUT;
550
551   if ($0 ne 'lf') {
552     print OUT "usage: $0 $opts [-F regexp] [file...]\n";
553   }
554   $opts =~ s/R//;
555   print OUT "usage: lf $opts regexp [directory...]\n";
556   print OUT <<EOD;
557 options: -l  long list (implicit if called 'll')
558          -a  list also .* files
559          -s  sort by size
560          -t  sort by time
561          -U  sort by nothing (original i-node order)
562          -c  list status change time instead of modification time
563          -u  list last access time instead of modification time
564          -i  list also inode and hard links numbers
565          -d  do not list contents of diretories
566          -n  numerical output
567          -r  reverse list
568          -z  squeeze size field (slows down output)
569          -L  derefernce symbolic links
570          -R  recursive into subdirs
571          -x  do not cross filesystem boundaries with -R
572          -F  find files matching case insensitive regexp
573          -N  show only normal (regular) files
574          -S  print statistics summary at end
575          -*  list plain file names (without \\ masking)
576          -f  user defined format output, format characters are:
577              m=mode, u=user, g=group, s=size, l=hard links count, i=inode
578              n=name only, d=date, a=access+modification+inodechange dates
579          -D  list only files newer than X and older than Y
580              XY format: NUMBER[smhd] (s=seconds, m=minutes, h=hours, d=days)
581              XY format: YYYY-MM-DD (Y=year, M=month, D=day)
582          -E  show examples
583 EOD
584   exit $status;
585 }
586
587 sub examples {
588   print <<EOD;
589 l *.c            # list files ending with .c
590 l -la            # list all files in long format
591 l -Rrs           # list files recursive reverse sorted by size
592 l -*f mus        # list files native names with format: mode+user+size
593 l -D 10d:        # list files newer than 10 days
594 ll               # list files long format (equal to: l -l)
595 lll              # list files extra long format (equal to: l -liS)
596 lf 'status.*mp3' # list files matching regexp (equal to: l -F 'status.*mp3')
597 lf sda1 /dev     # list devices matching sda1 (equal to: l -RF sda1 /dev)
598 EOD
599   exit;
600 }