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; }