[perl] 続・初めてのPerl 第9章 「リファレンスを使った実践的なテクニック」

練習問題の回答をメモ。

ex09-1

#!/usr/bin/perl
use strict;
use warnings;

#my @sorted = sort { -s $a <=> -s $b } glob "/bin/*";
#print "$_\n" foreach @sorted;

my @sorted_schwartz =
    map $_->[0],
    sort{  $a->[1] <=>  $b->[1] }
    map [ $_, -s $_ ],
    glob "/bin/*";
print "$_\n" foreach @sorted_schwartz;

ex09-2

#!/usr/bin/perl
use strict;
use warnings;
use Benchmark;

my $loop_count = 50_000;

timethese($loop_count,
          {
            schwartz_sort => sub {
              my @sorted_schwartz =
                  map $_->[0],
                  sort{  $a->[1] <=>  $b->[1] }
                  map [ $_, -s $_ ],
                  glob "/bin/*";
            },
            normal_sort => sub {
              my @sorted = sort { -s $a <=> -s $b } glob "/bin/*";
            },
          }
      );

ex09-3

#!/usr/bin/perl
use strict;
use warnings;

my @castaways = ("Skipper",
                  "Gilligan",
                  "Professor",
                  "Ginger",
                  "Mary_Ann",
              );
my @output_data = map $_->[0], sort {$a->[1] cmp $b->[1]} map [$_, &ignore_case($_)], @castaways;
print "$_\n" foreach @output_data;

sub ignore_case {
  my $name = shift;
  $name =~ tr/A-Z/a-z/;
  $name =~ tr/a-z//cd;
  $name;
}

ex09-4

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;

sub data_for_path {
  my $path = shift;
  if (-f $path or -l $path) {
    return undef;
  }
  if (-d $path) {
    my %directory;
    opendir PATH, $path or die "Cannot opendir $path: $!";
    my @names = readdir PATH;
    closedir PATH;
    for my $name (@names) {
      next if $name eq '.' or $name eq '..';
      $directory{$name} = data_for_path("$path/$name");
    }
    return \%directory;
  }
  warn "$path is neither a file nor a directory\n";
  return undef;
}

sub dump_data_for_path {
  my $path = shift;
  my $data = shift;
  my $nest_level = shift;

  # File::Basenameモジュールは「初めてのPerl p.224」を参照
  my $base_name = basename $path;

  if (not defined $data) {
    print " " x $nest_level, "$base_name\n";
    return;
  }
  my %directory = %$data;

  # ハッシュ内にキーと値のペアが存在する場合にのみ真を返す。ラクダ本 p.91
  if (%directory) {
    print " " x $nest_level, "<<$base_name, with contents:>>\n";
  } else {
    print " " x $nest_level, "<<$base_name, an empty directory>>\n";
  }

  $nest_level += 2;

  for (sort keys %directory) {
    dump_data_for_path("$path/$_", $directory{$_}, $nest_level);
  }
}
dump_data_for_path('.', data_for_path('.'));

共通の処理はできるだけまとめよう。
$nest_level は名前と役割がかみ合ってないし、2以外を渡すと駄目なので、有害だね。解答のように prefix が指定できるようにすればよかったかな。解答を参考に書き換えると以下のようになる。

sub dump_data_for_path {
  my $path = shift;
  my $data = shift;
  my $prefix = shift || "";

  # File::Basenameモジュールは「初めてのPerl p.224」を参照
  my $base_name = basename $path;

  print "$prefix$base_name";

  if (not defined $data) {
    print "\n";
    return;
  }

  my %directory = %$data;

  # ハッシュ内にキーと値のペアが存在する場合にのみ真を返す。ラクダ本 p.91
  if (%directory) {
    print ", with contents:\n";
    for (sort keys %directory) {
      dump_data_for_path("$path/$_", $directory{$_}, "$prefix  ");
    }
  } else {
    print ", an empty directory\n";
  }
}
dump_data_for_path('.', data_for_path('.'), ">  ");

反省点

API として関数を公開するときは、どんな引数をとることが適切か考えよう。
汎用性も考えよう。