"ls -l"の真似

訳あって、Perlで限定版ll(ls -l)を実装。パラメータは無し。アクセス権はrwxだけ、タイムスタンプは一律"yyyy/mm/dd hh:mi:ss"。

use strict;
use warnings;

sub to_type_s {
    $_ = shift or return;
    return "d" if -d;
    return "b" if -b;
    return "c" if -c;
    return "p" if -p;
    return "l" if -l;
    return "s" if -S;
    return "-";
}

sub to_mode_s {
    my $mode = shift or return;
    my @b = split //, sprintf "%9b", $mode & 0777;
    for (0..8) {
	$b[$_] = $b[$_] ? substr("rwx", $_ % 3, 1) : "-";
    }
    return join ("", @b) . " ";
}

sub to_time_s {
    my $t = shift or return;
    my @t = localtime $t;
    @t[5, 4] = ($t[5] + 1900, $t[4] + 1);
    sprintf "%04d/%02d/%02d %02d:%02d:%02d", @t[5, 4, 3, 2, 1, 0];
}

my @files = glob "*";
my $size_width = (@files)
    ? (sort { $b <=> $a } map { length(-s) } @files)[0]
    : 1;
for (@files) {
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	$atime,$mtime,$ctime,$blksize,$blocks) = stat;
    my $owner = eval "getpwuid($uid)";
    my $group = eval "getgrgid($gid)";
    my $owner_group = (defined $owner && defined $group)
	? sprintf "%7s %7s", $owner, $group
	: "? ?";
    printf "%s%s%d %s %*d %s %s\n",
    to_type_s($_),
    to_mode_s($mode),
    $nlink,
    $owner_group,
    $size_width,
    $size,
    to_time_s($mtime),
    $_;
}

最初のバージョンも残しておきます。

use strict;
use warnings;

sub to_mode_str {
  my $mod = shift or return;
  my @b = split //, sprintf "%9b", $mod & 511;
  for (0..8) {
    $b[$_] = $b[$_] ? substr("rwx", $_ % 3, 1) : "-";
  }
  return join "", @b;
}

sub to_time_str {
  my $t = shift or return;
  my @t = localtime $t;
  @t[5, 4] = ($t[5] + 1900, $t[4] + 1);
  sprintf "%04d/%02d/%02d %02d:%02d:%02d", @t[5, 4, 3, 2, 1, 0];
}

for (glob "*") {
  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = stat;
  my $owner = getpwuid($uid);
  my $group = getgrgid($gid);
  printf "%s%9s %d %s %s%7d %s %s\n",
    ((-d) ? "d" : "-",
     to_mode_str($mode),
     $nlink,
     $owner,
     $group,
     $size,
     to_time_str($mtime),
     $_);
}