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

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

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 = 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 }

45 $postsort = $opt_t||$opt_s;

46 $postproc = $postsort||$opt_z;

48 &examples if ${'opt_?'};

50 # mark for squeeze operation

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

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

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 }

64 $older = $newer = 0;

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 }

87 # preselect date field number

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

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

90 else { $sdf = 'm' }

92 # any arguments?

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

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

96 # build files list

97 &collect(@ARGV);

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 }