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