Perlで学ぶ「詳解 UNIXプログラミング」(その4) 第4章 ファイルとディレクトリ

はじめに

「詳解 UNIXプログラミング」の第四章を示します。

4.1 指定したファイルの種類を出力する

もっと種類は調べられますが、Python版に合わせています。
詳しくは "man 2 stat"等を参照してください。

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

use Fcntl ":mode";

# 指定したファイルの種類を出力する

die "Usage $0 file1 file2 ..." if scalar @ARGV == 0;

for my $file (@ARGV) {
    my $mode = (lstat $file)[2];

    print "$file type is ";

    if (S_ISREG($mode)) {
        print "regular file\n"
    } elsif (S_ISDIR($mode)) {
        print "directory\n";
    } elsif (S_ISCHR($mode)) {
        print "character special\n"
    } elsif (S_ISLNK($mode)) {
        print "symbolic link\n"
    } else {
        print "** unknown mode **\n";
    }
}

普段の Perlだと以下のファイルテストを使った方がいいと思います。
ただシンボリックリンクが -fと -lを満たしてしまうので、厳密に
やりたい場合は両方調べたり、順番を気にする必要がありそうです。
ファイルテストは 'perldoc -f -x'で調べられます。

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

# 指定したファイルの種類を出力する(ファイルテストを利用)

die "Usage $0 file1 file2 ..." if scalar @ARGV == 0;

for my $file (@ARGV) {
    print "$file type is ";

    if (-l $file) {
        print "symbolic link\n"
    } elsif (-d $file) {
        print "directory\n";
    } elsif (-c $file) {
        print "character special\n"
    } elsif (-f $file) {
        print "regular\n"
    } else {
        print "** unknown mode **\n";
    }
}

4.2 ファイルにアクセス可能かチェックする

Pythonの os.R_OKみたいなのが見当たらなかったので、
8進数の値を直接使ってます。

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

# ファイルにアクセス可能かチェックする
my $file = shift or die "Usage: $0 file\n";
my $mode = (stat($file))[2];

if ($mode & 0444) {
    print "read access OK\n";
} else {
    die "access error for $file\n";
}

open my $fh, "<", $file or die "Can't open file $!\n";
print "open for reading OK\n";
close $fh;

4.3 umask関数の使用例

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

use Fcntl ":mode";

# umask関数の使用例
my ($before_mode, $after_mode);

open my $fh, ">", "before.txt" or die "Can't open before.txt $!\n";
$before_mode = (stat $fh)[2] & 0777;
close $fh;

my $mode = S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
umask $mode or die "umask is not implemented\n";

open my $fh2, ">", "after.txt" or die "Can't open after.txt $!\n";
$after_mode = (stat $fh2)[2] & 0777;
close $fh2;

printf "before permission: 0%o, after permission: 0%o\n"
    , $before_mode, $after_mode;

unlink "before.txt", "after.txt";

ちゃんとマスクされていることが確認できます。

  % perl 4_3.pl
  before permission: 0644, after permission: 0600

4.4 chmod関数の使用例

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

use Fcntl ':mode';

# chmod関数の使用例
my $file = shift or die "Usage: $0 file\n";

my $orig = (stat $file)[2] & 07777;

# turn on set-group-ID and turn off group-execute
my $new_permission = (($orig & ~S_IXGRP) | S_ISGID) & 07777;
printf "test = %o\n", $new_permission;
chmod $new_permission, $file or die "Can't chmod $file\n";

確認。

 % ls -l test
  -rwxrwxrwx 1 syohei syohei 0 2011-04-06 00:07 test
 % perl 4_4.pl test
 % ls -l test
 -rwxrwSrwx 1 syohei syohei 0 2011-04-06 00:07 test

4.5 ファイルをオープンし、アンリンクする

何がしたいか意味がわからないプログラムだったんですが、本によると
unlinkしただけではスペースは解放されなくて、このプロセスが終了したときに
スペースが解放されることが示されています。


"file unlinked"が出力された直後に dfをした場合、spamというファイルは
見かけ上なくなっているけど、まだ spamのスペースは残っている。
で、"done"の後、つまりこのプロセスが exitしたあとに dfすると spam
スペースが解放されているということらしいのですが、Perlだと unlinkした
時点でもうスペースが解放されてしまっていました。

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

# ファイルをオープンし、アンリンクする
my $file = "spam";
open my $fh, "+>", $file or die "Can't open file $!\n";
unlink $file or die "Can't unlink file $!\n";

print "file unlinked\n";
sleep 15;
print "done\n";

4.6 utime()関数の例

Python版と若干違います。ここでは簡単な touchコマンドを実現して
みました。touchの本来の目的は空ファイルを作ることでないのであしからず。

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

use POSIX;

# utime()関数の例

die "Usage $0 file1 file2 ..." if scalar @ARGV == 0;

my ($atime, $mtime);
$atime = $mtime = time;
utime $atime, $mtime, @ARGV;

4.7 ファイルの種類を数えながら、再帰的にディレクトリ構造を辿る

Perlだと再帰的にディレクトリを辿りたい場合は File::Findがお手軽でしょう。

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

use Fcntl ":mode";
use File::Find;

# ファイルの種類を数えながら、再帰的にディレクトリ構造を辿る

my $search_dir = shift or die "Usage: $0 search_dir\n";

my %file_type;
sub calc {
    my $file = $File::Find::name;

    my $mode = (lstat $file)[2];

    if (S_ISREG($mode)) {
        $file_type{regular_file}++;
    } elsif (S_ISBLK($mode)) {
        $file_type{block_special}++;
    } elsif (S_ISCHR($mode)) {
        $file_type{char_special}++;
    } elsif (S_ISFIFO($mode)) {
        $file_type{FIFOs}++;
    } elsif (S_ISLNK($mode)) {
        $file_type{symbolic_link}++;
    } elsif (S_ISSOCK($mode)) {
        $file_type{sockets}++;
    } elsif (S_ISDIR($mode)) {
        $file_type{directories}++;
    }
}

find(\&calc, $search_dir);

my $total = 0;
map { $total += $_; } values %file_type;

while (my ($key, $val) = each %file_type) {
    $key =~ s{_}{ };

    printf "%15s: %10d, %10g\n", $key, $val, $val*100/$total;
}

確認

  % perl 4_7.pl /dev
        sockets:          1,    0.13624
    directories:         60,    8.17439
  symbolic link:        375,    51.0899
   char special:        172,    23.4332
   regular file:         98,    13.3515
  block special:         28,    3.81471

4.8 chdir()の例

これは単純ですね。

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

# chdir()の例

chdir "/tmp" or die "Can't chdir /tmp\n";
print "chdir to /tmp succeeded.\n"

4.9 getcwd()の例

普通に使うのであれば、Cwd::getpwdを使うのが良いでしょう。

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

use POSIX;

# getcwd()の例
chdir "/tmp" or die "Can't chdir /tmp\n";

printf "cwd = %s\n", POSIX::getcwd();

4.10 st_devとst_rdevを出力する

最近の Linuxは動的にデバイスファイル作っているっぽいので、
/devで試してみてもわかりづらい。

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

use Fcntl ':mode';

# st_devとst_rdevを出力する

die "Usage: $0 file1 file2 ..." if scalar @ARGV == 0;

for my $file (@ARGV) {
    my ($dev, $mode, $rdev) = (lstat $file)[0,2,6];

    printf "dev = %d/%d\n", ($dev & 0xff00) >> 8, $dev & 0xff;

    my $type;
    if (S_ISBLK($mode)) {
        $type = "block";
    } elsif (S_ISCHR($mode)) {
        $type = "character";
    } else {
        next;
    }

    printf "  %s(%s) major: %d, minor %d\n",
        $file, $type, ($rdev & 0xff00) >> 8, $rdev & 0xff;
}

まとめ

「詳解 UNIXプログラミング」の第四章を示しました。
こういうことをしたい場合は POSIXモジュールを調べるのがいいでしょう。