]> git.treefish.org Git - fex.git/blob - bin/l
Original release 20150120
[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 = 0;
26 ${'opt_*'} = ${'opt_?'} = 0;
27 $opt_m = $opt_f = $opt_F = $opt_D = '';
28 &usage if !getopts('hdnlLNitcuarsUSRz*?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         collect(getfiles($f));
171       }
172       
173     } else {
174   
175       # suppress trailing / on -d option
176       $f =~ s:/$:: if $opt_d;
177     
178       # on trailing / list subdirs, too
179       if ($f =~ m:/$:) { &list(&getfiles($f)) }
180       elsif ($f eq '') { &list('/') }
181       else {
182         if ($opt_L) {
183           unless (-e $f) {
184             warn "$0: dangling symlink $f\n";
185             next;
186           }
187           $f = abs_path($f);
188         }
189         list($f);
190       }
191       
192     }
193   }
194 }
195
196
197 # list file(s)
198 #
199 # INPUT: filenames
200 #
201 # GLOBAL: @LIST (filenames-list)
202 sub list {
203   my @files = @_;
204   my ($file,$line,$linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
205   my ($day);
206
207   foreach $file (@files) {
208
209     next if $opt_F and not fmatch($file);
210     next if $opt_N and (not -f $file or -l $file);
211
212     # get file information
213     # if ($opt_L and stat $file or not $opt_L and lstat $file) {
214     if (lstat $file) {
215       ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates) = &info($file);
216     } elsif ($! eq "Permission denied") {
217       $linkname = $file;
218       $inode = $links = $size = $uid = $gid = '?';
219       $mode = $opt_l ? '?---------' : '?---';
220       $date = '????-??-?? ??:??:??';
221       %dates = ('m' => 0, 'a' => 0, 'c' => 0);
222     } else {
223       warn "$0: ".quote($file)." - $!\n";
224       next;
225     }
226
227     $day = $date;
228     $day =~ s/\s.*//;
229     
230     if ($older) {
231       next if $older =~ /-/ and $day gt $older;
232       next if $older !~ /-/ and $dates{m} > time-$older;
233     }
234     if ($newer) {
235       next if $newer =~ /-/ and $day lt $newer;
236       next if $newer !~ /-/ and $dates{m} < time-$newer;
237     }
238     
239     if (defined $linkname) {
240
241       # prepend sorting string
242       $line = '';
243       $line = sprintf '%21s',$date if $opt_t;
244       $line = sprintf '%21s',$size if $opt_s;
245
246       unless ($opt_n) {
247         $uid = substr($uid,0,8);
248         $gid = substr($gid,0,8);
249       }
250
251       # user defined format?
252       if ($opt_f) {
253         foreach my $i (split '',$opt_f) {
254           if ($opt_n) {
255             $i =~ tr/AD/ad/;
256             if    ($i eq 'm') { $line .= sprintf '%06o ',  $mode }
257             elsif ($i eq 'u') { $line .= sprintf '%6d ',   $uid }
258             elsif ($i eq 'g') { $line .= sprintf '%6d ',   $gid }
259             elsif ($i eq 's') { $line .= sprintf "$z%16s ",$size }
260             elsif ($i eq 'l') { $line .= sprintf '%3s ',   $links }
261             elsif ($i eq 'i') { $line .= sprintf '%14s ',  $inode }
262             elsif ($i eq 'd') { $line .= sprintf '%10s ',  $date }
263             elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ', 
264                                          $dates{'a'},$dates{'m'},$dates{'c'} }
265           } else {
266             if    ($i eq 'm') { $line .= $mode.' ' }
267             elsif ($i eq 'u') { $line .= sprintf '%-8s ',  $uid }
268             elsif ($i eq 'g') { $line .= sprintf '%-8s ',  $gid }
269             elsif ($i eq 's') { $line .= sprintf "$z%19s ",$size }
270             elsif ($i eq 'l') { $line .= sprintf '%3s ',   $links }
271             elsif ($i eq 'i') { $line .= sprintf '%14s ',  $inode }
272             elsif ($i eq 'd') { $line .= $date.' ' }
273             elsif ($i eq 'D') { $line .= $date.' ' }
274             elsif ($i eq 'a') { $line .= &isodate($dates{'a'}).' '.
275                                          &isodate($dates{'m'}).' '.
276                                          &isodate($dates{'c'}).' ' }
277             elsif ($i eq 'A') { $line .= &isodate($dates{'a'}).' '.
278                                          &isodate($dates{'m'}).' '.
279                                          &isodate($dates{'c'}).' ' }
280           }
281         }
282         
283       # predefined formats
284       } else {
285       
286         if ($opt_n) {
287           if ($opt_l) { $line .= sprintf "%06o %6d %6d $z%15s %10d ",
288                                          $mode,$uid,$gid,$size,$date }
289           else        { $line .= sprintf "%06o $z%15s %10d ",
290                                          $mode,$size,$date }
291         } else {
292           if ($opt_l) { $line .= sprintf "%s %-8s %-8s $z%19s %s ",
293                                          $mode,$uid,$gid,$size,$date }
294           else        { $line .= sprintf "%s $z%19s %s ",
295                                          $mode,$size,substr($date,0,-3) }
296         }
297         
298         if ($opt_i)   { $line .= sprintf '%3s %10s ',$links,$inode }
299       }
300
301       $line .= $linkname."\n";
302       
303       if ($postproc) { 
304         push @LIST,$line;
305       } else { 
306         $line =~ s/\0//;
307         print $line;
308       }
309       $found++;
310       
311     } else {
312       lstat $file;
313       warn "$0: cannot get dir-info for ".quote($file)." - $!\n";
314     }
315     
316   }
317 }
318
319 # get file information
320 #
321 # INPUT: file name
322 #
323 # OUTPUT: filename with linkname, inode, hard link count, size, mode string, 
324 #         UID, GID, isodate
325 sub info {
326   my $file = shift;
327   my ($linkname,$links,$mode,$bmode,$uid,$gid,$date,%dates,@stat);
328   my $size = '-';
329   my $inode = '?';
330   my @rwx = qw/--- --x -w- -wx r-- r-x rw- rwx/;
331   my $type;
332
333   if ($opt_L) { @stat = stat $file }
334   else        { @stat = lstat $file }
335   
336   if (@stat) {
337   
338     $inode = $stat[1];
339     $bmode = $stat[2];
340     $links = $stat[3];
341     %dates = ('m' => $stat[9], 
342               'a' => $stat[8], 
343               'c' => $stat[10]);
344
345     if ($opt_n) {
346       $uid  = $stat[4];
347       $gid  = $stat[5];
348       $date = $dates{$sdf};
349     } else {
350       $uid  = getpwuid($stat[4]) || $stat[4];
351       $gid  = getgrgid($stat[5]) || $stat[5];
352       $date = &isodate($dates{$sdf});
353     }
354     
355     if    (-f _)            { $type = '-'; $size = $stat[7]; }
356     elsif (!$opt_L && -l _) { $type = 'l'; }
357     elsif (-d _)            { $type = 'd'; }
358     elsif (-c _)            { $type = 'c'; $size = &nodes($stat[6]); }
359     elsif (-b _)            { $type = 'b'; $size = &nodes($stat[6]); }
360     elsif (-p _)            { $type = 'p'; }
361     elsif (-S _)            { $type = 's'; }
362     else                    { $type = '?'; }
363
364     if ($opt_n) {
365       $mode = $stat[2];
366       $size = $stat[7] if $size eq '-';
367     } else {
368       if ($opt_l) {
369         $mode = $rwx[$bmode & 7];
370         $bmode >>= 3;
371         $mode = $rwx[$bmode & 7] . $mode;
372         $bmode >>= 3;
373         $mode = $rwx[$bmode & 7] . $mode;
374         substr($mode,2,1) =~ tr/-x/Ss/ if -u _;
375         substr($mode,5,1) =~ tr/-x/Ss/ if -g _;
376         substr($mode,8,1) =~ tr/-x/Tt/ if -k _;
377         $mode = $type.$mode;
378       } else {
379         # with short list display only effektive file access modes
380         $mode = $type 
381                 . (-r _ ? 'R' : '-')
382                 . (-w _ ? 'W' : '-')
383                 . (-x _ ? 'X' : '-');
384         substr($mode,2,1) =~ tr/-x/Ss/ if -u _ or -g _;
385         substr($mode,3,1) =~ tr/-x/Tt/ if -k _;
386       }
387     }
388
389   # fall back to ls command if perl lstat failed
390   } else {
391     if ($opt_L) {
392       return;
393     } else {
394       ($mode,$links,$uid,$gid,$size) = split /\s+/,`ls -ld $file 2>/dev/null`;
395       return undef unless defined $mode;
396       $type = substr($mode,0,1);
397       # for (my $i=0;$i<3;$i++) { push @dates,'????-??-?? ??:??:??' }
398       # $date = `gfind $dir -maxdepth 1 -name $file -printf '%Ty-%Tm-%Td %TT\n'`;
399     }
400   }
401
402   # summarize statistics
403   if ($opt_S) {
404     $SS++;
405     $SS{$type}++;
406     $Ss += $size if $type eq '-';
407   }
408
409   $size = &d3($size);
410   
411   # determine longest size field
412   if ($opt_z) {
413     my $x = length $size;
414     $opt_z = $x if $x>$opt_z;
415   }
416   $linkname = ${'opt_*'} ? $file : quote($file) ;
417   if ($type eq 'l' and $opt_f !~ /n/) {
418     my $link = readlink($file);
419     if (defined $link) {
420       $linkname .= ' -> ' . (${'opt_*'} ? $link : quote($link));
421     }
422   }
423   $mode =~ s/\+$//;
424   #$mode .= ' ' unless $mode =~ /\+$/;
425   
426   return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
427 }
428
429
430 # reformat integer into 3-digit doted format
431 # (when non-numerical mode is set)
432 #
433 # INPUT: integer or '-'
434 #
435 # OUTPUT: d3-string
436 sub d3 {
437   local $_ = shift;
438   if ($opt_n) { s/-/0/ }
439   else        { while (s/(\d)(\d\d\d\b)/$1,$2/) {} }
440   return $_;
441 }
442
443
444 # get all files matching pattern $opt_m
445 #
446 # INPUT: directory to scan
447 #
448 # OUTPUT: files which match (sorted, directories first)
449 sub getfiles {
450   my $dir = shift;
451   my @files = ();
452   my @dirs = ();
453   my $f;
454
455   if (opendir D,$dir) {
456     $dir = '' if $dir eq '.';
457     while (defined($f = readdir D)) { 
458     
459       # skip . and .. pseudo-subdirs
460       next if $f =~ m:(^|/)\.\.?/*$:;
461       # skip ONTAP snapshot dir
462       next if $f =~ m:(^|/)\.snapshot/*$:;
463       
464
465       # skip jed and emacs backup files
466       # next if $f =~ /~$/ and not $opt_a and not $opt_l;
467       
468       if ($f =~ /$opt_m/) {
469         my $x = $dir.$f;
470         if (not -l $x and -d $x and not ($opt_R or $postsort or $opt_U)) { 
471           push @dirs,$x;
472         } else { 
473           push @files,$x;
474         }
475       }
476     }
477     closedir D;
478     unless ($postsort) {
479       @files = &$lcsort(@files);
480       @dirs  = &$lcsort(@dirs);
481     }
482   } else {
483     warn "$0: cannot read $dir : $!\n";
484   }
485   
486   return (@dirs,@files);
487 }
488
489
490 # reformat integer to string node
491 #
492 # INPUT: integer node
493 #
494 # OUTPUT: string node
495 sub nodes {
496   my $rdev = shift;
497   return sprintf("%03d,%03d", ($rdev >> 8) & 255, $rdev & 255);
498 }
499
500
501 # reformat timetick to ISO date string
502 #
503 # INPUT: timetick
504 #
505 # OUTPUT: ISO date string
506 sub isodate {
507   my @d = localtime shift;
508   return sprintf('%d-%02d-%02d %02d:%02d:%02d',
509                  $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
510 }
511
512
513 # quote file name to printable name and escape shell meta chars
514 #
515 # INPUT: original file name
516 #
517 # OUTPUT: printable file name
518 sub quote {
519   local $_ = shift;
520   my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};';
521   
522   unless (defined $_) {
523     die "@_";
524     @x = caller;
525     die "@x";
526   }
527   if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) {
528     s/([$mc])/\\$1/g;
529     s/^~/\\~/;
530 # } elsif (/[$mc]/ or -d and /:/) {
531   } elsif (/[$mc]/) {
532     $_ = "'$_'";
533   }
534   return $_;
535 }
536
537
538 sub fmatch {
539   my $file = shift;
540   my $link = readlink($file)||'';
541
542   return $file if basename($file) =~ /$opt_F/i;
543   return $link if basename($link) =~ /$opt_F/i;
544 }
545
546
547 sub usage {
548   my $opts = '[-lastcuidnrzLRNS*] [-f format] [-D X:Y]';
549   if ($0 ne 'lf') { 
550     print "usage: $0 $opts [-F regexp] [file...]\n";
551   }
552   $opts =~ s/R//;
553   print "usage: lf $opts regexp [directory...]\n";
554   print <<EOD;
555 options: -l  long list
556          -a  list also .* files
557          -s  sort by size
558          -t  sort by time
559          -U  sort by nothing (original i-node order)
560          -c  list status change time instead of modification time
561          -u  list last access time instead of modification time
562          -i  list also inode and hard links numbers
563          -d  do not list contents of diretories
564          -n  numerical output
565          -r  reverse list
566          -z  squeeze size field (slows down output)
567          -L  derefernce symbolic links
568          -R  recursive into subdirs
569          -F  find files matching case insensitive regexp
570          -N  show only normal (regular) files
571          -S  print statistics summary at end
572          -*  list plain file names (without masking \\)
573          -f  user defined format output, format characters are:
574              m=mode, u=user, g=group, s=size, l=hard links count, i=inode
575              n=name only, d=date, a=access+modification+inodechange dates
576          -D  list only files newer than X and older than Y 
577              XY format: NUMBER[smhd] (s=seconds, m=minutes, h=hours, d=days)
578              XY format: YYYY-MM-DD (Y=year, M=month, D=day)
579          -?  show examples
580 EOD
581   exit 2;
582 }
583
584 sub examples {
585   print <<EOD;
586 l *.c            # list files ending with .c
587 l -la            # list all files in long format
588 l -Rrs           # list files recursive reverse sorted by size 
589 l -*f mus        # list files native names with format: mode+user+size
590 l -D 10d:        # list files newer than 10 days
591 ll               # list files long format (equal to: l -l)
592 lll              # list files extra long format (equal to: l -liS)
593 lf 'status.*mp3' # list files recursive matching regexp (equal to: l -RF)
594 lf sda3 /dev     # list devices matching sda3 (equal to: l -RF sd3 /dev)                                                       
595 EOD
596   exit;
597 }