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

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