The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
This isn't done, but I had it lying around, and it's *almost* done.
It emulates `ls -l' *only*.  I put considerable work into making it
exactly compatible with the real ls -l.

Since the rest of ls is mostly sorting options, and a thing to display
output in columns, it should be pretty easy to turn this into a clone
of the full ls.  Hint hint.

It requires Stat::lsMode.

	http://www.plover.com/~mjd/perl/lsMode/
	http://www.perl.com/CPAN/authors/id/MJD/Stat-lsMode-0.50.tar.gz

#!/usr/bin/perl
#
# ls-l
#
# mjd-perl-ppt@plover.com
#

use Stat::lsMode qw(format_mode);
my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

my @files = @ARGV ? @ARGV :  qw(.);
my @lines;

for (grep {-l || ! -d} @files) {
  my ($blocks, $line) = do_file($_);
  push @lines, $line;
}
print map {$_->[1]} sort {$a->[0] cmp $b->[0]} @lines;

foreach $f (grep {-d && ! -l} @files) {
  if (opendir DIR, $f) {
    print "\n", $f, ":\n" unless @files == 1;
    ($blocks, @lines) = do_files($f, readdir DIR);
    closedir DIR;
  } else {
    warn "ls: $f: $!\n";
  }
  print "total $blocks\n";
  print map {$_->[1]} sort {$a->[0] cmp $b->[0]} @lines;
}

sub do_file {
  my $file = shift;
  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = lstat $file;
    unless (defined $dev) {
      warn "ls: $_: $!\n";
      next;
    }
  my $perms = format_mode($mode);
  my $name = $_;
  if ($perms =~ /^l/) {
    my $link = readlink "$dir/$_";
    $name = "$name -> $link";
  }
  my $date = format_time($mtime);
  my ($u, $g) = ui($uid, $gid);
  ( $blocks,
    [$name, 
     sprintf("%s %3d %-8s %-8s %8d %s %s\n", 
	     $perms, $nlink, $u, $g, $size, $date, $name,
	    )
    ]
  );
}

sub do_files {
  my $dir = shift;
  my $tot_blocks = 0;
  for (@_) {
    next if /^\./;
    my ($blocks, $line) = do_file("$dir/$_");
    $tot_blocks += $blocks;
    push @lines, $line;
  }
  ($tot_blocks/2, @lines);
}

sub ui {
  my ($u, $g) = @_;
  $u = ($u{$u} ||= getpwuid($u));
  $g = ($g{$g} ||= getgrgid($g));
  ($u, $g);
}

# Date formats:
# Recent: Mmm dd hh:mm   (day space-filled; hour zero-filled T24)
$daterecent = '%b %d %H:%M';
# Older:  Mmm dd  yyyy
$dateolder = '%b %d  %Y';

sub format_time {
  my $time = shift;
  return $time{$time} if exists $time{$time};
  my $timestr;
  my @time = localtime($time);
  my ($sec, $min, $hour, $day, $mon, $year) = localtime($time);

  if ($time < $^T - 180*24*3600 || $time > $^T + 3600) {
    $timestr = sprintf "$mon[$mon] %2d  %4d", $day, $year+1900;
  } else {
    $timestr = sprintf "$mon[$mon] %2d %02d:%02d", $day, $hour, $min;
  }

  $time{$time} = $timestr;
}