簡単な grep コマンドを作ってみる

ファイル名の列挙やファイルの読み書きの仕方を勉強したので、復習のために簡単なプログラムを作ってみます。お題は「grep コマンド」。1つのファイル、もしくはフォルダ中のファイルから、検索パターンにマッチする行を表示します。といっても、オプションなどが無い単純なものです。
仕様としては、

perl grep.pl 検索パターン 検索先ファイル

として呼び出すものとします。検索パターンは検索に使用する正規表現。検索先ファイルは検索先となるファイル名です。検索先ファイルとしてファイル名グロブを指定すれば、複数のファイルを検索できるものとします。また、検索パターンのオプションは無しで固定にしたいと思います。

というわけで、作ってみたのがこのコードです。（なんだか3分クッキングみたいですが(^_^;）

use strict;
 
sub main() {
  if (defined(@ARGV) && @ARGV >= 2) {
    do_grep($ARGV[0], $ARGV[1])
  } else {
    print <<'HELP';
Usage: perl grep.pl PATTERN TARGET
Example: perl grep.pl "^\s*sub" grep.pl
Example: perl grep.pl "^use strict;$" *.pl
HELP
  }
}
 
sub do_grep($@) {
  my ($pattern, @target) = @_;
 
  @target = map { glob($_) } @target;
  for my $fn (@target) {
    eval { do_grep_file($pattern, $fn); };
    if ($@) { print STDERR "Error: $@\n"; }
  }
}
 
sub do_grep_file($$) {
  my ($pattern, $fn) = @_;
 
  open TARGET, $fn or die "Can't open $fn: $!";
  while (<TARGET>) {
    chomp;
    print "$fn($.): $_\n" if (/$pattern/);
  }
  close TARGET or die "Can't close $fn: $!";
}
 
main();

そんなに複雑にはなりませんでした。わかりやすいように関数を分割してあります。main 関数が最初に実行されます。以下に各関数について解説します。

main 関数では、@ARGV で渡された引数のチェックをしています。引数が2個以上指定されている場合は do_grep 関数を呼び出し、それ以外の場合はヘルプを表示して終了します。

do_grep 関数では、まず引数の受け取り方に注目してください。このように受け取った場合 $_[0] が $pattern に代入され、$_[1] 以降の要素は全て @target に格納されます。
次に、@target の全ての要素に対して map 関数で、勉強したばかりの glob 関数を適用しています。こうすることで @target に入っている全てのファイル名グロブが展開されます。うまい事に単なるファイル名（hoge.txt など）に glob 関数を適用した場合、ファイル名がそのまま返ってくるので、map 関数で各対応がきちんとなされる事になります。

@target = ("hoge.txt", "*.pl");
の場合
@target = ("hoge.txt", "a.pl", "b.pl", "c.pl", "grep.pl");
のように展開されます

map 関数が上手く使えると気持ちいいですね。(^_^)

そして、@target の中のファイル名それぞれに対して do_grep_file 関数を呼び出します。ここには見慣れない eval と $@ がありますね。do_grep_file を囲んでいるブロックを eval 関数で評価しています。
これは、いわゆる「例外処理」と呼ばれるもので、C++やJavaなどの「try?catch」にあたります。（ラクダ本を読んで見つけました）
本来 die 関数が実行されると、そこでプログラムの実行が終了してしまいますが、eval ブロックの中で die 関数を呼び出した場合は、eval ブロックを抜け出すだけになります。そして、そのエラーメッセージが特殊変数である $@ に格納されているのです。（die 関数が throw にあたると考えればわかりやすいですね）　ちなみに eval ブロックの中で例外が発生しなかった場合は、$@ が空文字列になる事が保証されているそうです。
つまりこの場合は do_grep_file 関数の中で die 関数が呼び出されると（例外が発生すると）、そのエラーメッセージを標準エラー出力（STDERR）に出力して、プログラムの実行を続けます。とりあえずこんな理解で問題ないでしょうか。
例外処理はまた別の機会に詳しく勉強したいと思います。

do_grep_file 関数では、検索パターンと検索対象となるファイル名を受け取り、実際に grep を行ないます。ファイルの open は勉強しましたね。

  while (<TARGET>) {
    chomp;
    print "$fn($.): $_\n" if (/$pattern/);
  }

は、TARGET ファイルハンドルから1行ずつ読み出して処理しています。（この場合は特例で、読み出した行が暗黙的に $_ にセットされるのでしたね）
chomp 関数は引数を省略した場合「chomp $_;」と同じ意味です。渡した変数の最後についている改行を削除してくれます。
そして、検索パターンにマッチする行を print しています。見慣れない変数 $. ですが、これはファイルハンドルの「現在の行番号」が入っています。1行目の場合は 1 が、10行目の場合は 10 が入っているので、マッチした行番号を表示できます。

というわけで、実行例として書かれている引数で実行すると、実行結果は以下の通りです。

D:\home\palmo>perl grep.pl "^\s*sub" grep.pl
grep.pl(3): sub main() {
grep.pl(15): sub do_grep($@) {
grep.pl(25): sub do_grep_file($$) {

検索パターンは sub で関数定義をしている行にマッチします。上手く動きましたね。(^_^)
また、ファイル名グロブを使って確かめてみます。

D:\home\palmo>perl grep.pl "^use strict;$" *.pl
accessor5.pl(2): use strict;
accessor5.pl(13): use strict;
accessor6.pl(2): use strict;
argv.pl(1): use strict;
arrayslice.pl(1): use strict;
(中略)
tr.pl(1): use strict;
tr2.pl(1): use strict;
tr3.pl(1): use strict;
tr4.pl(1): use strict;
undef.pl(1): use strict;
wraplist.pl(1): use strict;

こちらも上手く動きました。(^_^)