「初めてのPerl」 13章 (ファイルとディレクトリの取り扱い)

IT 勉強 Perl

「総集編 GANTZ the 1000 Vol.1」を買って読んでみたbonlifeです。1048ページで800円。やっぱりGANTZは良いね。
ということで、お久しぶりのPerlです。「初めてのPerl」の13章は「ファイルとディレクトリの取り扱い」。13章の内容はだいたい以下のような感じです。

  • ファイルの削除 (unlink)
  • ファイルの名前を変更 (rename)
  • リンク (link, symlink)
  • ディレクトリの作成と削除 (mkdir, rmdir)
  • パーミッションの変更 (chmod)
  • ファイルのオーナーの変更 (chown)
  • タイムスタンプの変更 (utime)
  • 単純なモジュールの利用
    • File::Basenameモジュール
    • File::Specモジュール

こういうのって慣れてるせいか「シェルで書いた方が簡単！」とか思ってしまいましたよ。でも、コマンド名もほとんど同じですし、特に難しい部分はなかったかな。モジュールの使い方はちゃんとマスターしたいですね。というわけで、早速練習問題のbonlife的(not 模範)解答例です。
ex13-1.pl

  • rmと同じ働きをするプログラムを書く
  • コマンドラインに指定したすべてのファイルを削除
  • rmのオプションを扱う必要はない
#! perl
use strict;
use warnings;

my @files;
foreach (@ARGV) {
    push @files, glob "$_" ;
}
foreach my $file (@files) {
    my $successful = unlink $file;
    if ( $successful != 0 ){
        print "I deleted \"$file\".\n";
    } else {
        print "I couldn't delete \"$file\". : $!\n";
    }
}

出力結果は以下の通り。

ex13-1.pl *.dat aaa bbb
I deleted "a.dat".
I deleted "b.dat".
I deleted "c.dat".
I deleted "aaa".
I couldn't delete "bbb". : No such file or directory

解答例を見て気づいたことは以下の通り。

  • もっとシンプルに解く
  • globは意識しなくて良かったっぽい

解答例があまりにもシンプルでビックリでしたよ。ということで、続いて2問目。
ex13-2.pl

  • mvと同じ働きをするプログラムを書く
  • 1番目のコマンドライン引数で指定したファイルを2番目のコマンドライン引数で指定した名前にリネーム
  • 2番目の引数にはディレクトリも指定できるようにし、その場合、新しいディレクトリの中で、リネームする前と同じベース名を持つようにする
  • mvのオプションや3個以上の引数を扱う必要はない
#! perl
use strict;
use warnings;
use File::Basename qw(basename);
use File::Spec;

if ( $#ARGV + 1 != 2 ) {
    print "Please input 2 arguments.\n";
    exit 1;
}

my $org_name, my $new_name;
$org_name = $ARGV[0];
$new_name = $ARGV[1];

if ( -d $new_name ){
    my $basename = basename $org_name;
    my $new_name = File::Spec->catfile($new_name, $basename);
    rename $org_name, $new_name or warn "can't rename $org_name to $new_name : $!\n";
} else {
    rename $org_name, $new_name or warn "can't rename $org_name to $new_name : $!\n";
}

出力結果は特にないので省略。解答例を見て気づいたことは以下の通り。

  • 引数のチェックは不要
  • 一行で引数をまとめて変数に代入した方が格好良い
  • renameの行は共通なので、if文の外に出せる

ソース書きながら、なんとなく同じようなことをどこかで書いてしまっている気がしましたが、あらためて見るとrenameコマンドがある2行は全く同じでした…。続いて、3問目。
ex13-3.pl

  • lnと同じ働きをするプログラムを書く
  • 1番目のコマンドライン引数に対して、2番目の引数で指定した名前を持ったハードリンクを作成
  • lnのオプションや3個以上の引数を扱う必要はない
#! perl
use strict;
use warnings;
use File::Basename qw(basename);
use File::Spec;

if ( $#ARGV + 1 != 2 ) {
    print "Please input 2 arguments.\n";
    exit 1;
}

my $org_name, my $link_name;
$org_name  = $ARGV[0];
$link_name = $ARGV[1];

if ( -d $link_name ){
    my $basename  = basename $org_name;
    my $link_name = File::Spec->catfile($link_name, $basename);
    link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
} else {
    link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
}

出力結果は特にないので省略。解答例を見て気づいたことは2問目と同じなので省略。4問目。
ex13-4.pl

  • 問題3のプログラムを改造して、引数の前に-sスイッチを指定した場合、ハードリンクの代わりにシンボリックリンクを作成するようにする
#! perl
use strict;
use warnings;
use File::Basename qw(basename);
use File::Spec;
use Getopt::Std;

our($opt_s);
getopts('s');

if ( $#ARGV + 1 != 2 ) {
    print "Please input 2 arguments.\n";
    exit 1;
}

my $org_name, my $link_name;
$org_name  = $ARGV[0];
$link_name = $ARGV[1];

if ($opt_s){
    if ( -d $link_name ){
        my $basename  = basename $org_name;
        my $link_name = File::Spec->catfile($link_name, $basename);
        symlink $org_name, $link_name or warn "can't symlink $org_name to $link_name : $!\n";
    } else {
        symlink $org_name, $link_name or warn "can't symlink $org_name to $link_name : $!\n";
    }
} else {
    if ( -d $link_name ){
        my $basename = basename $org_name;
        my $link_name = File::Spec->catfile($link_name, $basename);
        link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
    } else {
        link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
    }
}

出力結果は以下の通り。

ex13-4.pl -s a.dat b.dat
The symlink function is unimplemented at C:\test\perl\ex13\ex13-4.pl line 26.

あらまぁ。やはりWindows(のActivePerl)ではsymlinkは使えませんでしたか。
解答例を見て気づいたことは以下の通り。

  • オプションが1つぐらいだったら第1引数である$ARGV[0]をチェックすれば良い
  • 2つ目の引数がディレクトリかどうかによって処理を分ける部分は、-sの有無に関係なく共通なので、if文の外に出すべき (if文のネストが不要)

やはり、自分で書いてて「あー、なんか無駄に長い気がする。」と思ったところは解答例では短くなってますね。勉強になります。そして、ラストの5問目。
ex13-5.pl

#! perl
use strict;
use warnings;

my @files;
@files = glob "* .*";
foreach my $file (@files){
    if (-l $file){
        my $where = readlink $file;
        printf "%-20s -> %-20s\n", $file, $where;
    }
}

出力結果はなし。(そもそもシンボリックリンク自体がないので。)解答例を見て気づいたことは以下の通り。

  • globで取得した配列を渡すのではなく、foreachに直接globを渡してしまった方がスッキリ
  • シンボリックリンクかどうかのチェックをせず、readlinkの結果、$whereに値がセットされたかどうかをdefinedで確認するとシンプル

なるほど、としか言いようがありませんね。readlinkの結果によって表示するかどうかを制御すれば良かったなんて。早くこういうのをパッと思いつくようになりたいです。
ちなみに最近では「初めてのPerl」の問題は解ききってませんが、「続・初めてのPerl」読んでます。分かったような気になったり、ならなかったりする日々です。

続・初めてのPerl - Perlオブジェクト、リファレンス、モジュール

続・初めてのPerl - Perlオブジェクト、リファレンス、モジュール