The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
########################################
# code extract
#   for CODES/chap09/12:Program: lst/1.cod
# paragraph 271 of chap09.pod
########################################

#!/usr/bin/perl
# lst - list sorted directory contents (depth first)

use Getopt::Std;
use File::Find;
use File::stat;
use User::pwent;
use User::grent;

getopts('lusrcmi')				or die <<DEATH;
Usage: $0 [-mucsril] [dirs ...]
 or    $0 -i [-mucsrl] < filelist

Input format:
	-i  read pathnames from stdin
Output format:
	-l  long listing
Sort on:
	-m  use mtime (modify time) [DEFAULT]
	-u  use atime (access time)
	-c  use ctime (inode change time)
	-s  use size for sorting
Ordering:
	-r  reverse sort
NB: You may only use select one sorting option at a time.
DEATH
	
unless ($opt_i || @ARGV) { @ARGV = ('.') }

if ($opt_c + $opt_u + $opt_s + $opt_m > 1) {
	die "can only sort on one time or size";
}

$IDX = 'mtime';
$IDX = 'atime' if $opt_u;
$IDX = 'ctime' if $opt_c;
$IDX = 'size'  if $opt_s;

$TIME_IDX = $opt_s ? 'mtime' : $IDX;

*name = \$File::Find::name;  # forcibly import that variable

# the $opt_i flag tricks wanted into taking
# its filenames from ARGV instead of being
# called from find.

if ($opt_i) {
	 *name = *_;  # $name now alias for $_
	 while (<>) { chomp; &wanted; }   # ok, not stdin really
}  else {
	find(\&wanted, @ARGV);
}

# sort the files by their cached times, youngest first
@skeys = sort { $time{$b} <=> $time{$a} } keys %time;

# but flip the order if -r was supplied on command line
@skeys = reverse @skeys if $opt_r;

for (@skeys) {
	unless ($opt_l) {  # emulate ls -l, except for permissions
	    print "$_\n";
	    next;
	}
	$now = localtime $stat{$_}->$TIME_IDX();
	printf "%6d %04o %6d %8s %8s %8d %s %s\n",
		$stat{$_}->ino(),
		$stat{$_}->mode() & 07777,
		$stat{$_}->nlink(),
		user($stat{$_}->uid()),
		group($stat{$_}->gid()),
		$stat{$_}->size(),
		$now, $_;
}

# get stat info on the file, saving the desired
# sort criterion (mtime, atime, ctime, or size)
# in the %time hash indexed by filename.
# if they want a long list, we have to save the
# entire stat object in %stat.  yes, this is a
# hash of objects
sub wanted {
	my $sb = stat($_);  # XXX: should be stat or lstat?
	return unless $sb;
	$time{$name} = $sb->$IDX();  # indirect method call
	$stat{$name} = $sb if $opt_l;
}

# cache user number to name conversions
sub user {
	my $uid = shift;
	$user{$uid} = getpwuid($uid)->name || "#$uid"
	    unless defined $user{$uid};
	return $user{$uid};
}

# cache group number to name conversions
sub group {
	my $gid = shift;
	$group{$gid} = getgrgid($gid)->name || "#$gid"
	    unless defined $group{$gid};
	return $group{$gid};
}