続・lsコマンドをPerlで

lsコマンドをPerlで - Perl日記
前回の「ls」コマンドをもう一度やってみた。
画面幅の取得は「Term::ReadKey」を使えばいいみたい。
でもPerl5.8.5では入ってなかったので、一応eval()。
「Getopt::Std」もまた今度。

#!/usr/bin/perl -T
# ls.pl
# "ls"コマンドをPerlで実装
use strict;
use warnings;
use List::Util qw(max first);

my $min_space = q{  }; # 最小スペース2マス

# 画面幅取得
my $wchar = eval {
  local $SIG{__DIE__}; local $SIG{__WARN__};
  require Term::ReadKey; # 端末画面幅取得用
  return (Term::ReadKey::GetTerminalSize())[0];
};

# use Getopt::Std; # 引数取得用
# と思ったけど自分で書いてみる
my %opt = ();
if (@ARGV) {
  LOOP_ARGV :
  for my $argv (@ARGV) {
    if ('-a' eq $argv) { # とりあえず -a だけ
      $opt{a} = 1;
      undef $argv;
    }
  }
  if (1 == grep($_, @ARGV)) {
#    $opt{path} = first { defined($_) }, @ARGV;
    ($opt{path}) = grep($_, @ARGV);
  }
}

# 表示ディレクトリ
$opt{path} ||= '.'; # 引数が指定されていなければカレントをデフォルトにする

# untainted
$opt{path} =~ s/^(\w+)$/$1/;

# ディレクトリ内ファイル取得
opendir my $dh, $opt{path}
  or die "ls.pl: $opt{path}: No Such file or directory\n"; # 改行を入れてスクリプトの死ではないように見せかける
my @files = map  { {name => $_, len => length($_)} }
#           sort grep { !/^\./ } # 不可視ファイルを無視
            sort
            readdir $dh;
closedir $dh;

if (!$opt{a}) { # -aオプションがなければ
  @files = grep { $_->{name} !~ /^\./ } @files; # 不可視ファイルを無視
}

# ファイル名最大長
my $maxlen_fname = max(@{[map($_->{len}, @files)]});
# ファイル数
my $count_f = @files;

if ($count_f) {

  # 列数
  my $cols = ($wchar)
           ? int($wchar / ($maxlen_fname + 2))
           : 4; # デフォルト値
  # 行数
  my $rows = ($count_f % $cols)
           ? int($count_f / $cols + 1)
           : int($count_f / $cols    );

  my @print_rows = ('dummy'); # [0]にダミーをセット

  # 表示ファイルを縦(列)に作っていく
  PUSH_FILENAME :
  while (@files) {
    my @temp = ('dummy'); # [0]にダミーをセット
    push @temp, shift(@files) for 1 .. $rows; # 添え字[1]からpush
    my $col_maxlen = max(@{[map($_->{len}, @temp[1 .. $rows])]});

    PUSH_FILENAME_ROWS :
    for my $i (1 .. $rows) { # 各行
      if ($temp[$i]) {
        if (my $diff_len = $col_maxlen - $temp[$i]->{len}) {
          $temp[$i]->{name} = $temp[$i]->{name}.(q{ } x $diff_len);
        }
        # ★ここが重要
        my $index = ($i % $rows) ? ($i % $rows) : $rows;
        push @{$print_rows[$index]}, $temp[$i]->{name}.$min_space;
      }
    }
  }

  shift @print_rows; # ダミーを捨てる

  local $" = q{}; #"
  for my $print_row (@print_rows) {
    print "@$print_row\n";
  }
}

__END__