git.treefish.org Git - fex.git/blob

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

9 use Cwd qw'abs_path';

10 use File::Basename;

11 use Getopt::Std;

13 # the name of the game

14 $0 =~ s:.*/::;

16 $ENV{LC_CTYPE} = 'C';

18 # unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'};

20 @ARGV = grep { chomp } <STDIN> if "@ARGV" eq '-';

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 }

40 $postsort = $opt_t||$opt_s;

41 $postproc = $postsort||$opt_z;

43 # mark for squeeze operation

44 $z = $opt_z ? "\0" : '';

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 } @_ } }

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 }

57 $older = $newer = 0;

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 }

80 # preselect date field number

81 if ($opt_c) { $sdf = 'c' }

82 elsif ($opt_u) { $sdf = 'a' }

83 else { $sdf = 'm' }

85 # any arguments?

86 if (@ARGV) { @ARGV = &$lcsort(@ARGV) }

87 else { @ARGV = &getfiles('.') }

89 # build files list

90 &collect(@ARGV);

92 # post process files list?

93 # remark: if no postprocessing, files list has been already printed in list()

94 if (@LIST && $postproc) {

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;

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 }