第13章 ファイルとディレクトリの取り扱い 練習問題 その2

同じような問題が続きます。

3. lnと同じように動くプログラムを作る

lnといってもハードリンクを作る部分だけです。13章の練習問題 2問目とほとんど同じ。removeをlinkに変える。

#!/usr/bin/env perl -w
use strict;
use File::Basename;
use File::Spec;

my ($src, $dst) = @ARGV;

if (-d $dst) {
    my $bname = basename $src;
    my $dst = File::Spec->catfile($dst, $bname);
}

#removeになってるところをlinkに変えた
link $src, $dst
    or die "can't link $src to $dst: $!";

4. 3のプログラムに機能追加。-sオプションでシンボリックリンクの作成ができるようにする

うまく分岐させないと、コードの重複が多くなりそうなプログラム。DRYを少し気にしながら。

#!/usr/bin/env perl -w
use strict;
use File::Basename;
use File::Spec;

# -sオプションがあるかを判定してあればフラグをセット
my $issym = 0;
if ($ARGV[0] eq '-s') {
    shift @ARGV;
    $issym = 1;
}

# このへんは一つ前や、二つ前の問題と全く同じ
my ($src, $dst) = @ARGV;

if (-d $dst) {
    my $bname = basename $src;
    my $dst = File::Spec->catfile($dst, $bname);
}

# フラグで分岐
if ($issym) {
    symlink $src, $dst
        or die "can't link $src to $dst: $!";
} else {
    link $src, $dst
        or die "can't symlink $src to $dst: $!";
}

なんかフラグを使ってしまってるあたりがあんまりきれいじゃないな。しかし、解答でもフラグを使っているようだったので、仕方ないかしらね。

5. カレントディレクトリに存在するシンボリックリンクを見つけてその値を表示するプログラムを作る

カレントディレクトリのファイルをグロブして一つずつ調べます。

#!/usr/bin/env perl -w
use strict;

foreach (<*>) {
    if (-l $_) { # シンボリックリンクかどうか
        my $origine = readlink $_; # リンク先を取得
        print "$_ -> $origine\n";
    }
}

readlinkはシンボリックリンクの値を取得できる。これは、結構シンプルにできてすてきです。しかし、もっとシンプルにできた。readlinkは渡されたファイルがシンボリックリンクじゃなかったらundefを返すのねー。これをふまえて書き直すと、

#!/usr/bin/env perl -w
use strict;

foreach (sort <*>) {
    my $origine = readlink $_; # リンク先を取得
    print "$_ -> $origine\n" if defined $origine; #シンボリックリンクであれば
}

これを試しに/usr/binで実行してみました。結果の一部は以下に。

tclsh -> tclsh8.4
tnameserv -> /System/Library/Frameworks/JavaVM.framework/Versions/CurrentJDK/Commands/tnameserv
unpack200 -> /System/Library/Frameworks/JavaVM.framework/Versions/CurrentJDK/Commands/unpack200
update_sharing -> /System/Library/Frameworks/JavaVM.framework/Versions/CurrentJDK/Commands/update_sharing
vi -> vim
view -> vim
vimdiff -> vim
wish -> wish8.4
wx-config -> ../lib/wx/config/mac-unicode-debug-2.5

初めてのPerl