blog20100901

2013/08/20 - プログラミング言語 Perl にまつわる etc. - Perl monger
参考 : perldoc, perldoc.jp, search.cpan.org, perldoc.perl.org ...
「 初めての Perl 第 6 版 」(オライリー・ジャパン発行 ISBN978-4-87311-567-2) 」
「 続・初めての Perl 改訂版 」(オライリー・ジャパン発行 ISBN4-87311-305-9) 」
「 Effective Perl 第 2 版 」(翔泳社発行 ISBN978-4-7981-3981-4) 」 ... etc,.

Perl Perl_7

Perl モジュール File::Find でファイル/ディレクトリの処理をする (d171)

目次 - Perl Index


Theme



Perl について、復習を兼ねて断片的な情報を掲載して行く連載その d171 回。

今回は、「 File::Find - サブディレクトリを再帰的に処理する - Perl ゼミ 」をベースにしてモジュール「 File::Find 」の使い方を確認します。File::Find のドキュメントは (d168) で確認しました。




テスト用のファイル/ディレクトリ作成



まず、「 File::Find 」の機能を確認するためのテスト用ディレクトリツリーを作成します。

ディレクトリツリーの作成にはモジュール「 File::Path 」の旧タイプ API「 mkpath 」と C 言語のライブラリ「 Fcntl.h 」の定義をロードするモジュール「 Fcntl 」のシンボルを使いました (i.e. ここで File::Find は使わない)。

コードは次の通りです:

FILE NAME: mkdirs.pl


#!/usr/bin/env perl



use strict;

use warnings;



use File::Path;

use Fcntl;

#use File::Find;



# creates dir & file



# $$ : スクリプトを実行している Perl のプロセス番号 

my $topdir = "test$$";



# 作成するディレクトリリスト

my $dirs = [

             "$topdir/d1",

             "$topdir/d1/d1-1/d1-2",

             "$topdir/d2/"

					 ];



# ディレクトリを作成

for my $dir (@$dirs){

  eval { mkpath $dir };

	if (@!) { die "@!" }

}



# 作成するファイルリスト

my $files = [

              "$topdir/f0.txt",

              "$topdir/d1/f1.txt",

              "$topdir/d1/d1-1/f1-1.txt",

              "$topdir/d1/d1-1/f1-2.txt",

              "$topdir/d2/f2.txt"

						];



# ファイルを作成

for my $file (@$files) {

  sysopen (my $fh, $file, O_WRONLY | O_CREAT | O_EXCL )

	  or die "Cant create $file: $!";

	close $fh;

}



print "ディレクトリ:\n";

print "\t$_\n" for @$dirs;

print "ファイル:\n";

print "\t$_\n" for @$files;

print "作成しました.\n";


13 行目の変数「 $$ 」はスクリプトを実行する Perl のプロセス ID です。これによりディレクトリ名が例えば「 test2291 」のようにそのときのプロセス ID を伴った名前になるので、複数回ディレクトリ作成を実行しても名前の重複を避けられます。

変数「 $$ 」のような Perl で予め定義されている組み込み変数のリストは variable - perldoc で一覧できます。

このプログラムを実行すると次のような結果が得られます。



ディレクトリ:

	test4349/d1

	test4349/d1/d1-1/d1-2

	test4349/d2/

ファイル:

	test4349/f0.txt

	test4349/d1/f1.txt

	test4349/d1/d1-1/f1-1.txt

	test4349/d1/d1-1/f1-2.txt

	test4349/d2/f2.txt

作成しました.


(d169) で確認したコマンド「 tree 」を使えば、次のようにディレクトリツリーを一覧できます。



$ tree test4349/

test4349/

├── d1

│   ├── d1-1

│   │   ├── d1-2

│   │   ├── f1-1.txt

│   │   └── f1-2.txt

│   └── f1.txt

├── d2

│   └── f2.txt

└── f0.txt



4 directories, 5 files


末尾のリポート内容で 4 つのディレクトリと 5 つのファイルが作成されていることがわかります。


空のファイルに文字列を書き込むためのコード



作成したファイルはまだ空のままなので File::Find (の find()) を使って適当な文字列を書き込んでみます。コードは次のようにしました:

FILE NAME: file-find_msg_writer.pl


#!/usr/bin/env perl



use strict;

use warnings;



use File::Find;



# writing mesage to each files

my $msg_writer = sub {

  my $msg = "Are you ready?\n";



	# tests file using file test operator

	if (-f) {

		open my $fh, '>', $_ or die "Cant open $_: $!";

		print $fh "$msg";

		close $fh;

		chomp ($msg);

		print "$File::Find::name に $msg を書き込み\n";

	}



	# append mesage only under d1-1 dir 

  my $msg_d1_1 = "this file is under d1-1 dir\n";

	if (-f && $File::Find::dir =~ /d1-1/) {

		open my $fh_d1_1, ">>", $_ or die "cant open $_: $!";

		print $fh_d1_1 "$msg_d1_1";

		close $fh_d1_1;

		chomp ($msg_d1_1);

	  print "$File::Find::name に $msg_d1_1 を書き込み\n";

	}

	print "--\n";

};



# using glob() to expand file glob '*'

my $terget_dir = glob 'test*';



# File::Find::find()

find($msg_writer, $terget_dir);


File::Find による処理は File::Find がエクスポートする関数「 find() 」(37 行目) で行います。find() で実行したい処理はユーザがサブルーチンとして自由に書くことができます。

find() は第 1 引数にサブルーチンのリファレンス、第 2 引数にディレクトリのリストを取ります。第 1 引数にはハッシュリファレンスを使うことで処理に対する任意のオプションも指定出来ます。詳細は (d168) を参照してください。

このコードでは 9 - 31 行目で「 ファイルに文字列を書き込む 」ためのサブルーチンを定義しています。「 sub{...}; 」による無名サブルーチンのリファレンス (コードリファレンス) を使っているのは find() の第 1 引数がサブルーチンのリファレンスだからです。コードリファレンスはスカラ変数「 $msg_writer 」に格納しています。

上記のようにサブルーチンをリファレンス化しなくとも、find(\&wanted, @directories_to_search) の書式に準じて次のように指定すれば実行出来ます。



find(\&your_subroutine, @dirs);


ここで定義している find() のためのサブルーチンはいわゆる「 クロージャ 」(closure) と呼ばれるものです。


[10 - 19 行目] ファイルテスト



$msg_writer に格納したサブルーチンは、すべてのファイルに文字列「 Are you ready? 」を書き込みます。



  my $msg = "Are you ready?\n";



	# tests file using file test operator

	if (-f) {

		open my $fh, '>', $_ or die "Cant open $_: $!";

		print $fh "$msg";

		close $fh;

		chomp ($msg);

		print "$File::Find::name に $msg を書き込み\n";

	}


書き込み対象はファイルのみなので、ファイルテスト演算子「 -f 」を使って対象がファイルかどうかをチェックをします。Fild::Find では現在のファイル名が暗黙の変数「 $_ 」にセットされているので if ( -f ) { ... } でテストできます。

ファイルテスト演算子は以下で確認しました。




[22 - 29 行目] 条件にマッチするファイルにのみ書き込む



次に「 ディレクトリ d1-1 配下のファイル 」という条件にマッチするファイルにのみ書き込みを行う処理が続きます。



  my $msg_d1_1 = "this file is under d1-1 dir\n";

	if (-f && $File::Find::dir =~ /d1-1/) {

		open my $fh_d1_1, ">>", $_ or die "cant open $_: $!";

		print $fh_d1_1 "$msg_d1_1";

		close $fh_d1_1;

		chomp ($msg_d1_1);

	  print "$File::Find::name に $msg_d1_1 を書き込み\n";

	}

	print "--\n";

};


ファイルテスト「 -f 」を行うのは前項と同じですが、ディレクトリをチェックするために $File::Find::dir =~ /d1-1/ のテストを追加しています。スカラ変数「 $File::Find::dir 」は File::Find が現在のディレクトリ名をセットする専用の変数です。


[34 - 37 行目] find() の実行



このコードで File::Find による処理を行うのは 37 行目で、File::Find からエクスポートされた関数「 find() 」を使います。

34 行目で使っている「 glob 」はシェルの「 ファイルグロブ 」に似た機能を提供する演算子です。ここでは「 * 」(asterisk) を展開してディレクトリ名を補完しています。



my $terget_dir = glob 'test*';



# File::Find::find()

find($msg_writer, $terget_dir);


find() の第 1 引数にはクロージャとしてのサブルーチン (のリファレンス) 「 $msg_writer 」を、第 2 引数にはターゲットのディレクトリをセットします。

find() は、ターゲットのディレクトリを横断して各ファイル/ディレクトリの名前を専用の変数にセットします。



$File::Find::dir   現在のディレクトリ名

$_                 現在のファイル名

$File::Find::name  そのファイル/ディレクトリへのフルパス


自分で定義したサブルーチンは、これらの変数 (に格納されたファイル/ディレクトリ) に対しての処理を行えばよいわけです。

なお、find() の第 2 引数はリスト形式なので複数のディレクトリも指定できます。

glob については以下を参照してください。




プログラムの実行



このプログラムの実行結果は次のようになります。



$ perl file-find_msg_writer.pl 

--

test4349/f0.txt に1を書き込み

--

--

test4349/d1/f1.txt に1を書き込み

--

--

test4349/d1/d1-1/f1-1.txt に1を書き込み

test4349/d1/d1-1/f1-1.txt に1を書き込み

--

test4349/d1/d1-1/f1-2.txt に1を書き込み

test4349/d1/d1-1/f1-2.txt に1を書き込み

--

--

--

test4349/d2/f2.txt に1を書き込み

--


コマンド find と cat を使って実際に書き込みが成功しているかを確認してみます。



$ find test* -type f -exec cat {} \;

Are you ready?

Are you ready?

this file is under d1-1 dir

Are you ready?

this file is under d1-1 dir

Are you ready?

Are you ready?



特定の文字列を置換するプログラム



先ほど文字列を書き込んだ各ファイルの特定の文字列を置換してみます。文字列置換のためのコードは次のものです:

FILE NAME: file-find_msd_replacer.pl


#!/usr/bin/env perl



use strict;

use warnings;



use File::Find;



# replace msg "Are you ready?" to "Im already ready"

my $replace_msg = sub {

	if (-f) {

	  my @lines;

		my $msg1 = 'Are you ready\?';

		my $msg2 = "Im already ready!";

		open my $fh_in, '<', $_ or die "Cant open $_: $!";

		for my $line (<$fh_in>){

		  chomp $line;

			$line =~ s/$msg1/$msg2/;

			push @lines, $line;

		}

		close $fh_in;



		open my $fh_out, '>', $_ or die "Cant open $_: $!";

		for my $line (@lines) {

		  chomp $line;

			print $fh_out "$line\n";

		}

		close $fh_out;

	  print "'$msg1' を '$msg2' に置換しました.\n";

	}

};



my $terget_dir = glob 'test*';



find($replace_msg, $terget_dir);


処理の手順としては前項のコードと大差ありません。

14 - 20 行目でファイルの内容を読み込んで文字列を置換します。読み込んだ文字列は文字列置換を行った後で一度配列「 @lines 」に格納しておきます。

配列 @lines に格納したファイルの内容は 23 - 26 行目の fo (each) ループで元のファイルに書き込みを行います。これによりターゲットのファイルには置換が完了した文字列がセットされます。

前項のコードと同じく、実際の処理は 34 行目の find() で行います。

このコードを実行すると次の結果がえられます。



$ perl file-find_msg_replacer.pl 

'Are you ready\?' を 'Im already ready!' に置換しました.

'Are you ready\?' を 'Im already ready!' に置換しました.

'Are you ready\?' を 'Im already ready!' に置換しました.

'Are you ready\?' を 'Im already ready!' に置換しました.

'Are you ready\?' を 'Im already ready!' に置換しました.


ファイルの内容が書き換わっているかを確認します。



$ find test* -type f -exec cat {} \;

Im already ready!

Im already ready!

this file is under d1-1 dir

Im already ready!

this file is under d1-1 dir

Im already ready!

Im already ready!


問題ないようです。

文字列置換を含めた正規表現については以下を参照してください。




より安全・確実な処理は ?



極力間違いのない安全なファイル/ディレクトリの処理を行いたい場合は、open() の替わりによりきめ細かい設定が可能な「 sysopen() 」(と Fcntl) を使うと良いかもしれません。

sysopen() の使い方については perlopentut 5.18.1 などを参照しつつ別途確認する予定です。

# perlopentut 5.20.0 以降で sysopen 関連の項目が「 To be announced. Or deleted. 」になっているのはなぜでしょう ? ご存知の方がいれば教えてください。

またファイル/ディレクトリの処理に限りませんが、実際のところ様々なデータを処理する場合は Perl core や CPAN で用意されている各種モジュールを使ったほうが安全・確実な処理ができ、移植性も高くなるはずです。

どのようなモジュールがあるか、そのモジュールはどのように使うのかを身につけるにはそれなりのコストが必要ですが、それはコストに見合う成果を (きっと) もたらせてくれるでしょう。

せっかくなので、 今回確認した File::Find を使ってファイル操作ができそうなモジュールがどのくらいあるのかチェックしてみましょう。

次のコードは、現在自分のマシンにインストールされている利用可能なモジュールから「 File 」の名前をもったものをリストします。



#!/usr/bin/env perl



use strict;

use warnings;



use File::Find;



# Find ! File related Modules

my $listing_module = sub {

	if (-f && /\.pm/ && $File::Find::name =~ /File/) {

		my $modulename = ".../";

	    my @line = split /\//, $File::Find::name;

		$modulename .= join '/', @line[9 .. $#line];

		print "$modulename\n";

	}

};



# File::Find::find()

find($listing_module, @INC);


このコードでは「 ファイルテスト演算子 」, 「 論理演算子 」, 「 正規表現 」, 「 split 」, 「 join 」, 「 配列スライス 」, それから利用可能なモジュールのパスを格納した特別な配列変数「 @INC 」等を利用しています。これらはすべて当ブログ上で確認してきた基本的な機能なので、気になる方は index または site:pointoht.ti-da.net KEYWORD on Google 等でチェックしてみてください。

上記プログラムの実行結果は次のようになります:



$ perl file-find_listmodules.pl 

.../5.28.1/x86_64-linux/Devel/Cover/DB/File.pm

.../5.28.1/Test/Reporter/Transport/File.pm

.../5.28.1/x86_64-linux/Devel/Cover/DB/File.pm

.../5.28.1/File/Which.pm

.../5.28.1/File/Listing.pm

.../5.28.1/File/Slurp.pm

.../5.28.1/File/HomeDir.pm

.../5.28.1/File/HomeDir/Driver.pm

.../5.28.1/File/HomeDir/Test.pm

.../5.28.1/File/HomeDir/Unix.pm

.../5.28.1/File/HomeDir/Darwin.pm

.../5.28.1/File/HomeDir/FreeDesktop.pm

.../5.28.1/File/HomeDir/MacOS9.pm

.../5.28.1/File/HomeDir/Windows.pm

.../5.28.1/File/HomeDir/Darwin/Cocoa.pm

.../5.28.1/File/HomeDir/Darwin/Carbon.pm

.../5.28.1/LWP/DebugFile.pm

.../5.28.1/WWW/RobotRules/AnyDBM_File.pm

.../x86_64-linux/SDBM_File.pm

.../x86_64-linux/File/Glob.pm

.../x86_64-linux/File/DosGlob.pm

.../x86_64-linux/File/Spec.pm

.../x86_64-linux/File/Spec/Win32.pm

.../x86_64-linux/File/Spec/Epoc.pm

.../x86_64-linux/File/Spec/Unix.pm

.../x86_64-linux/File/Spec/Cygwin.pm

.../x86_64-linux/File/Spec/Functions.pm

.../x86_64-linux/File/Spec/AmigaOS.pm

.../x86_64-linux/File/Spec/Mac.pm

.../x86_64-linux/File/Spec/VMS.pm

.../x86_64-linux/File/Spec/OS2.pm

.../x86_64-linux/IO/File.pm

.../FileCache.pm

.../AnyDBM_File.pm

.../FileHandle.pm

.../Archive/Tar/File.pm

.../Test2/IPC/Driver/Files.pm

.../Tie/File.pm

.../x86_64-linux/SDBM_File.pm

.../x86_64-linux/File/Glob.pm

.../x86_64-linux/File/DosGlob.pm

.../x86_64-linux/File/Spec.pm

.../x86_64-linux/File/Spec/Win32.pm

.../x86_64-linux/File/Spec/Epoc.pm

.../x86_64-linux/File/Spec/Unix.pm

.../x86_64-linux/File/Spec/Cygwin.pm

.../x86_64-linux/File/Spec/Functions.pm

.../x86_64-linux/File/Spec/AmigaOS.pm

.../x86_64-linux/File/Spec/Mac.pm

.../x86_64-linux/File/Spec/VMS.pm

.../x86_64-linux/File/Spec/OS2.pm

.../x86_64-linux/IO/File.pm

.../Memoize/SDBM_File.pm

.../Memoize/AnyDBM_File.pm

.../Memoize/NDBM_File.pm

.../Memoize/ExpireFile.pm

.../File/Temp.pm

.../File/Fetch.pm

.../File/GlobMapper.pm

.../File/Path.pm

.../File/stat.pm

.../File/Find.pm

.../File/Copy.pm

.../File/Compare.pm

.../File/Basename.pm

.../TAP/Formatter/File.pm

.../TAP/Formatter/File/Session.pm

.../TAP/Parser/SourceHandler/File.pm


たくさんありますね。

なお、Perl Core に付属したモジュール「 Module::CoreList 」を使えばさらに簡潔なコードが書けます (しかもコアモジュールに絞って)。



#!/usr/bin/env perl



use strict;

use warnings;



use Module::CoreList;



print join "\n", Module::CoreList->find_modules(qr/File/i, 5.028000);

print "\n";


用途にマッチしたモジュールを使う効果の大きさが理解できました。


NEXT



次回は、find2perl の冒頭行を理解するために Bash の man を少し確認します。


参考情報は書籍「 続・初めての Perl 改訂版 」, 「 Effective Perl 第 2 版 」を中心に perldoc, Wikipedia および各 Web サイト。それと詳しい先輩。

目次 - Perl Index
































同じカテゴリー（Perl）の記事
 Perl mp2 翻訳 Web コンテンツ圧縮の FAQ (d228) (2023-10-11 23:49)
 Perl mp2 翻訳 既知のブラウザのバグの回避策をいくつか (d227) (2023-05-26 15:41)
 Perl mp2 翻訳 Perl と Apache でのキュートなトリック (d226) (2023-05-19 17:05)
 Perl mp2 翻訳 テンプレートシステムの選択 (d225) (2022-08-15 22:23)
 Perl mp2 翻訳 大規模 E コマースサイトの構築 (d224) (2022-06-15 20:43)
 Perl mp2 翻訳 チュートリアル (d223) (2022-06-15 20:42)

Llama
リャマ
ブログ内検索
TI-DA
てぃーだブログ
プロフィール
セラ (perlackline)
セラ (perlackline)
カテゴリー
Perl (790)
Perl_7 (92)
Perl_6 (100)
Perl_5 (100)
Perl_4 (100)
Perl_3 (100)
Perl_2 (100)
Perl_1 (100)
Perl_0 (100)
mod_perl (46)
翻訳 (141)
Web Server (48)
Perl_pre (4)
ディストリビューション (25)
PAUSE (7)
CPAN Testers (43)
オブジェクト指向プログラミング (23)
リファレンス (26)
デバッグ (10)
正規表現 (39)
memo (13)
パーミッション (13)
JavaScript (21)
css (54)
vi (6)
Perl_my_program (3)
done (2)
Git (1)
other (9)
Syntaxhighlighter (7)
コマンド (3)
Pod (2)
Index (1)
QRコード
QRCODE
オーナーへメッセージ

PAGE TOP ▲