「初めてのPerl」 12章 (ディレクトリ操作)

はてブを使い始めてみようと思ったのですが、結局人気エントリーばかりを登録してしまっている自分に気づき、早くも挫折モードのbonlifeです。「初めてのPerl」、早く終わらせて次に進みたいところですが、まだ12章…。12章の内容は以下の通りです。

  • ディレクトリの移動 (chdir)
  • グロブによるファイル名パターンの展開 (glob)
  • ディレクトリハンドル (opendir, readdir, closedir)

軽めの章ですね。globを使わないglobの書き方はファイルハンドルっぽくて分かりづらいので自分で書く時は使わないだろうなぁ。昔からPerl使ってる人はglobは使わないのかしら。うーむ。他にとりたてて書くこともないので、早速練習問題のbonlife的解答例です。
ex12-1.pl

  • ユーザからディレクトリ名を入力してもらい、そのディレクトリに移動し、ディレクトリの内容(ドットで始まるファイルを除く)をアルファベット順に表示
  • ユーザの入力した行に空白文字だけしか含まれていない場合、ユーザのホームディレクトリに移動
#! perl
use strict;
use warnings;

print "Enter a directory : ";
chomp(my $dir = <STDIN>);
if ( $dir =~ /^\s*$/ ) {
    chdir or die "Cannot chdir to your home dir : $!";
} else {
    chdir $dir or die "Cannot chdir to \"$dir\" : $!";
}

my @all_files = glob "*";
foreach my $file ( sort @all_files ) {
    print $file, "\n";
}

出力結果は以下の通りです。

ex12-1.pl
Enter a directory : .
ex10-1.pl
ex11-1.pl
ex11-2.pl
ex11-3.pl
ex12-1.pl
ex12-2.pl
ex12-3.pl
(攻略)
ex12-1.pl
Enter a directory :
Cannot chdir to your home dir : Bad file descriptor at ex12-1.pl line 8, <STDIN> line 1.

解答例を見て気づいたことは以下の通り。

  • Windows XPでは引数なしのchdirはまともに動かない様子

ソースコードもだいたい同じだったので、次の練習問題です。
ex12-2.pl

  • 問題1のプログラムを改造して、ドット以外で始まるものだけではなく、すべてのファイルを表示させる
#! perl
use strict;
use warnings;

print "Enter a directory : ";
chomp(my $dir = <STDIN>);
if ( $dir =~ /^\s*$/ ) {
    chdir or die "Cannot chdir to your home dir : $!";
} else {
    chdir $dir or die "Cannot chdir to \"$dir\" : $!";
}

my @all_files = glob ".* *";
foreach my $file ( sort @all_files ) {
    print $file, "\n";
}

出力結果は以下の通りです。

ex12-2.pl
Enter a directory : .
.
..
.file_whose_name_starts_with_dot
ex10-1.pl
ex11-1.pl
ex11-2.pl
ex11-3.pl
ex12-1.pl
ex12-2.pl
ex12-3.pl
(後略)

解答例を見て気づいたことは特になし。ということで、3問目。
ex12-3.pl

  • 問題2をグロブを使わずにディレクトリハンドルで解く
#! perl
use strict;
use warnings;

print "Enter a directory : ";
chomp(my $dir = <STDIN>);
opendir DH, $dir or die "Cannot change a directory to \"$dir\" : $!";

foreach my $file ( sort readdir DH ) {
    print $file, "\n";
}
closedir DH;

出力結果は問2の出力結果と同じなので省略します。
解答例を見て気づいたこと以下の通りです。

  • 空白行のチェックを追加し忘れました…
  • chdirした後、opendirする場合は、移動後のディレクトリを開くことになるため、opendirでは"."を開く

こういう基本的な内容は「ふーん。」って感じで面白みに欠けますね。でも、基礎がグラグラしたまま小手先の技に頼ってしまうのも気持ち悪いので、コツコツと勉強してみます。あー、飽きてしまいそう!

「初めてのPerl」 11章 (ファイルハンドルとファイルテスト)

家を出るのが面倒でせっかく当選したライヴに行かなかったbonlifeです。最低です…。休日はほぼ引きこもりです…。ということで、せっかく家にいるので、ちまちまと進めているPerlのお勉強の続きをやってみました。ようやく「初めてのPerl」の11章ですよ。われながら遅いっ!11章の内容はだいたい以下のような感じです。

  • ファイルハンドルの説明
  • dieによる致命的エラー発生
  • warnによる警告メッセージ表示
  • デフォルトのファイルハンドルの変更
  • ファイルテスト
  • stat関数とlstat関数
  • ビットストリング
  • 特別な下線ファイルハンドル

なるほど、なるほど、といった感じで読み進めることができました。と思いましたが、練習問題を解いてみると、案外理解できていないことに気づきました…。ということで、早速練習問題のbonlife的(not 模範)解答例です。
ex11-1.pl

  • ユーザから入力ファイル名、出力ファイル名、サーチパターン、置き換え文字列を対話的に入力させる
  • 入力ファイルを読み込んで、見つかったサー日パターンを置き換え文字列に置き換えて、出力ファイルへと書き出す
#! perl
use strict;
use warnings;

# 変数の宣言
my $input_file, my $output_file, my $search_pattern, my $replace_string;

# 入力ファイル名の入力
print "Please input an input file name : ";
while (<>) {
    chomp;
    $input_file = $_;
    if ( -f $input_file  && -r $input_file ) {
        last;
    } else {
        print "$input_file is not an readable file.\n";
        print "Please input an input file name : ";
    }
}

# 出力ファイル名の入力
print "Please input an output file name : ";
OUTPUT_INPUT : while (<>) {
    chomp;
    $output_file = $_;
    # $input_fileと$output_fileが同名の場合、再入力
    if ( $input_file eq $output_file ) {
        print "Output file must be different from input file.\n";
        print "Please input an output file name : ";
    # $output_fileが空文字列の場合、再入力
    } elsif ( $output_file =~ /^\s*$/ ) {
        print "Please input an output file name : ";
    # $output_fileが存在し、書き込み可能な場合、上書き確認
    } elsif ( -e $output_file && -w $output_file ) {
        print "\"$output_file\" already exists.\n";
        print "Do you really want to overwrite it? (Y/anything) : ";
        while (<>) {
            chomp;
            # Y または y の場合は上書きOK
            if ( /^\s*y\s*$/i ) {
                last OUTPUT_INPUT;
            # それ以外の文字列の場合、処理を終了
            } else {
                print "Stopped processing.\n";
                exit;
            }
        }
    # $output_fileが存在しない場合
    } elsif ( ! -e $output_file ) {
        last;
    # その他の場合
    } else {
        print "\"$output_file\" is not a writable file.\n";
        print "Please input an output file name : ";
    }
}

# サーチパターンの入力

print "Please input a search pattern : ";
while (<>) {
    chomp;
    $search_pattern = $_;
    if ( $search_pattern =~ /^\s*$/) {
        print "Please input a search pattern : ";
    }
    else {
        last;
    }
}

# 置き換え文字列の入力

print "Please input a replace string : ";
while (<>) {
    chomp;
    $replace_string = $_;
    last;
}

print "Start replacing...\n";
print "INPUT FILE     : ", $input_file,     "\n";
print "OUTPUT FILE    : ", $output_file,    "\n";
print "SEARCH PATTERN : ", $search_pattern, "\n";
print "REPLACE STRING : ", $replace_string, "\n";

open INPUT , "< $input_file"
    or die "Can't open $input_file. ($!)";
open OUTPUT, "> $output_file"
    or die "Can't open $output_file. ($!)";

while (<INPUT>) {
    $_ =~ s/$search_pattern/$replace_string/g ;
    print OUTPUT $_;
}
close INPUT ;
close OUTPUT;

出力結果は以下の通り。

  • wilma.txt
Wilma always sleeps.
Am I Wilman?
No, I'm Wilma.
WILMA is so big!
Oh, small wilma...
ex11-1.pl
Please input an input file name : wilma.txt
Please input an output file name : wilma_output.txt
Please input a search pattern : (wilma|WILMA)
Please input a replace string : Wilmo
Start replacing...
INPUT FILE     : wilma.txt
OUTPUT FILE    : wilma_output.txt
SEARCH PATTERN : (wilma|WILMA)
REPLACE STRING : Wilmo
  • wilma_output.txt
Wilma always sleeps.
Am I Wilman?
No, I'm Wilma.
Wilmo is so big!
Oh, small Wilmo...

解答例を見て気づいたことは以下の通り。

  • ユーザ入力を処理する部分はサブルーチンにした方が良い
  • $source, $destなんて変数を使った方がちょっとそれっぽい
  • 置換後の文字列では、特別な文字は展開されない

まだまだこざっぱりしたソースは書けませんが、動くものが出来たのでオーケーオーイェーということで。続いて2問目。
ex11-2.pl

  • コマンドラインからファイル名のリストを受け取る
  • その1つ1つについて、読み出し可能か、書き込み可能か、実行可能か、存在しないかを表示するプログラムを書く
#! perl
use strict;
use warnings;

# 引数の確認

if ( $#ARGV == -1 ) {
    print "Please specify more than 1 argument(s).\n";
    exit;
}

# 引数のリストが空になるまで処理を実行

while ( $#ARGV != -1 ) {
    &simple_file_test(shift(@ARGV));
}

# ファイルテストのサブルーチン

sub simple_file_test {
    # 存在するかどうか
    if ( -e $_[0] ) {
       print "$_[0] exists.\n";
    } else {
       print "$_[0] doesn't exist.\n";
    }
    # 読み出し可能かどうか
    if ( -r $_[0] ) {
       print "$_[0] is readable.\n";
    } else {
       print "$_[0] is not readable.\n";
    }
    # 書き込み可能かどうか
    if ( -w $_[0] ) {
       print "$_[0] is writable.\n";
    } else {
       print "$_[0] is not writable.\n";
    }
    # 実行可能かどうか
    if ( -x $_[0] ) {
       print "$_[0] is executable.\n";
    } else {
       print "$_[0] is not executable.\n";
    }
}

出力結果は以下の通り。

ex11-2.pl
Please specify more than 1 argument(s).
ex11-2.pl test01.txt test02.txt test99.txt
test01.txt exists.
test01.txt is readable.
test01.txt is writable.
test01.txt is not executable.
test02.txt exists.
test02.txt is readable.
test02.txt is writable.
test02.txt is not executable.
test99.txt doesn't exist.
test99.txt is not readable.
test99.txt is not writable.
test99.txt is not executable.

解答例を見て気づいたことは以下の通り。

  • ファイルが存在しない場合、その場でreturnした方が良い
  • テスト結果を配列にpushして、まとめて表示した方が良さそう
  • 特殊なファイルハンドルであるアンダーラインを使った方が動作が速い

サブルーチンの使い方を忘れかけていたので復習しながら解いてみました。ふむふむ。returnは上手く使いこなせていませんでしたね。続いて、3問目。
ex11-3.pl

  • コマンドラインからファイル名のリストを受け取って、もっとも古いファイルの名前とその古さを日数単位で表示するプログラムを書く
#! perl
use strict;
use warnings;

# 引数の確認

if ( $#ARGV == -1 ) {
    print "Please specify more than 1 argument(s).\n";
    exit;
}

# 引数のリストが空になるまで処理を実行

my %list_with_time;

while ( $#ARGV != -1 ) {
    my $file_name = shift @ARGV;
    my $timestamp = -M $file_name;
    if ( -e $file_name ) {
        $list_with_time{"$file_name"} = $timestamp;
    } else {
        print "WAR : \"$file_name\" doesn't exists.\n";
    }
}

# ファイルの情報を1つも取得できなかった場合の処理

if ( ( keys %list_with_time) == 0 ) {
    print "WAR : No file with timestamp specified.";
    exit;
}

# ハッシュのキーを値でソートした配列を作成

my @sorted_file_list = sort {
    $list_with_time{$b} <=> $list_with_time{$a}
} keys %list_with_time;

# 表示処理

printf "The oldest file is \"$sorted_file_list[0]\". : created or modified %d days ago.", $list_with_time{$sorted_file_list[0]};

出力結果は以下の通り。

ex11-3.pl test01.txt test02.txt test99.txt
WAR : "test99.txt" doesn't exists.
The oldest file is "test01.txt". : created or modified 97 days ago.

解答例を見て気づいたことは以下の通り。

  • 引数の有無のチェックはdieを使ってシンプルに書ける
  • 「最高水位線」アルゴリズム(high-water mark algorithm)を使った方がスッキリする

まぁ、こんな感じで一歩ずつ進んでいきます。今日はもうちょっと頑張ってみます!

「初めてのPerl」 10章 (さまざまな制御構造)

通勤中に音楽を聴くのがこんなに楽しいなんて!アメリカ旅行中に買った「Mastering Regular Expressions: Understand Your Data and Be More Productive」を読み終えるのがどんどん遅くなりそうな気がしているbonlifeです。ER-6i、なかなかのフィット感。勉強の秋。ということでプログラミングのお勉強を加速させようと思ってます。とりあえず「初めてのPerl」、いい加減終わらせます!10章で扱っている内容はだいたい以下のような感じです。

  • unless制御構造
  • until制御構造
  • 式修飾子 (短い書き方)
  • elsif節
  • オートインクリメントとオートデクリメント (++とか--とか、プリとかポストとか)
  • for制御構造
  • foreach (セミコロンがなしのforはforeach)
  • last演算子、next演算子redo演算子
  • ラベル付きブロック
  • 論理演算子 (&&とか||とか)

この章は特に難しくなかったような気がしました。(気のせいかもしれません。)unlessとかuntilは使わなそうですね。読めればオーケーかしら。last、next、redoはキチンと使いこなしたいところ。後、論理演算子は優先度に気をつけたいですね。ということで、練習問題のbonlife的粗悪解答例です。
ex10-1.pl

  • 1から100までの間から選んだ秘密の数をユーザに当ててもらうプログラムを書く
  • 入力した値が当たるまで何回でも繰り返してユーザに入力を求める
  • 乱数を得るには int(1 + rand 100) を使う
  • ユーザの入力した数が当たらなかったら、"Too high"または"Too low"と表示する
  • ユーザがquitまたはexitと入力したり、空行を入力したら、プログラム終了
  • 数が当たった時にもプログラム終了
#! perl -w
use strict;
my $rand_number = int( 1 + rand 100 );
print "Please input a number between 1 and 100. : \n";
while (<>) {
	chomp;
	if ( /^quit$|^exit$|^$/ ) {
		print "Goodbye!\n";
		exit;
	} elsif ( ! /^[0-9]+$/ ) {
		print "Please input correct number.\n";
	} elsif ( $_ < 0 || $_ > 100 ) {
		print "Please input a number between 1 and 100.\n";
	} elsif ( $_ > $rand_number ) {
		print "Too high!\n";
	} elsif ( $_ < $rand_number ) {
		print "Too low!\n";
	} elsif ( $_ == $rand_number) {
		print "Congratulations!\n";
		exit;
	} else {
		print "Sorry, some errors may occur.\n";
		print "Please ask this program's author.\n";
		exit;
	}
}

出力結果は以下の通り。

ex10-1.pl
Please input a number between 1 and 100. :
50
Too high!
25
Too low!
37
Too low!
43
Too high!
40
Too low!
41
Congratulations!
ex10-1.pl
Please input a number between 1 and 100. :
quit
Goodbye!
ex10-1.pl
Please input a number between 1 and 100. :
exit
Goodbye!

解答例を見て気づいたことは以下の通り。

  • デフォルトで繰り返しを行う場合、whileを常にtrueにしておき、lastでループを抜ける
  • スペースだけの行も空行として扱う

Perlベストプラクティス」をちゃんと読み込んでキレイなコードを書けるようにしなきゃ。まぁ、ボチボチ頑張ります。

Perlベストプラクティス

Perlベストプラクティス

画像ファイルのリネーム (Image::ExifToolを使ってみました)

会社ではこっそりとEXCEL VBAを勉強したりしているbonlifeです。oo4oでOracleにアクセスしてデータを取得し、新しいブックを作成して保存、みたいなツールを作って自己満足。(その件は後で整理してみます。)
さてさて、「初めてのPerl」の練習問題も終わってないのに、ちょっとした用事があったのでPerlでツールを作ってみました。よくあるリネームツールです。GUIベースのツールで簡単に出来ることを敢えてPerlで書くのはPerlっ子としてはアウトかもしれませんが、勉強中の身、ということで勘弁願いたいです。
おそらく出来るであろうことは、下記の通り。

  • 画像ファイルのファイル名をファイル作成日時(YYYYMMDD_hhmmss)にすること (Image::ExifToolの力)
  • ディレクトリを引数に指定した場合、そのディレクトリ以下のファイル全部を対象に処理 (File::Findの力)

問題点は以下の通りです。

  • ファイル作成日時が秒まで同じデータがあった場合、大事なファイルが天国に…

bonlifeが自分で出来たら良いな、と思うことは以下の通りです。

  • 連番にリネームする機能 (ディレクトリを再帰的に処理させる場合、ちょっと面倒かも)
  • Getopt::StdかGetopt::Longを使って色々なオプションに対応

まぁ、そんなこんなで素人がモジュールを使ったりしながら書いてみましたよ。
[参考URL]

スクリプトは以下の通りです。(気になる点、修正すべき点などあればご指摘お願いいたします。)

  • image_rename.pl
#! Perl

# use warnings;
use Image::ExifTool;
use File::Basename;
use File::Find;

# 引数の確認 (指定されていない場合エラー)

if ( $#ARGV < 0 ) {
    $script_name = basename($0);
    print "ERR : $script_name needs arguments.\n";
    print "      usage : $script_name path [path...]\n";
    exit 1;
}

# ファイル名のリストを取得

my @file_lists;
find sub {
    push(@file_lists,$File::Find::name) if -f
}, @ARGV;

my $exif_tool = new Image::ExifTool; # ExifToolオブジェクトの生成
my %date_list;

# ファイルごとにExifToolオブジェクトのImageInfoメソッドで
# Exif情報を取得

for $file (@file_lists) {
    my $exif_info = $exif_tool->ImageInfo($file);
    # for $key (sort keys %$exif_info) {
    #      print "$file - $key : $exif_info->{$key}\n";
    # }
    # Exif情報の中のCreateDateを取得
    my $creation_date = $exif_info->{CreateDate};
    # CreateDateの値を取得できなかった場合はメッセージを出力
    # 次のループに移動
    if ( ! $creation_date ){
        print "WAR : Can't get \"CreateDate\" information of \"$file\"\n";
        next
    }
    $creation_date =~ s|:||g ; # YYYY:MM:DD hh:mm:ss -> YYYYMMDD hhmmss
    $creation_date =~ s| |_|g; # YYYYMMDD hhmmss     -> YYYYMMDD_hhmmss
    # ハッシュにファイル名をキーにして整形したCreateDateを保存
    $date_list{$file} = $creation_date;
}

# ハッシュを値でソートした場合のキーの配列を取得

@keys = sort {
    $date_list{$a} cmp $date_list{$b}
} keys %date_list;

# キーの配列ごとに表示処理

for $file_path (@keys){
    # 現在の拡張子(一番最後のドット以降の文字列)を取得し、$extに代入
    $file_path =~ /(\..*$)/;
    $ext = $1;
    # File::Basenameのfileparseを使い、ファイルのパスを分解
    ($base,$path,$type) = fileparse($file_path,$ext);
    $old_file_name = $file_path;
    $new_file_name = "$path$date_list{$file_path}$type";
    # renameでリネーム
    rename($old_file_name,$new_file_name) or die "ERR : $!";
    print "INF : Renamed successfully : \"$old_file_name\" -> \"$new_file_name\"\n";
}

出力イメージは以下の通りです。

>image_rename.pl dir
WAR : Can't get "CreateDate" information of "dir/CCC.txt"
WAR : Can't get "CreateDate" information of "dir/DDD.txt"
WAR : Can't get "CreateDate" information of "dir/dir2/GGG.txt"
WAR : Can't get "CreateDate" information of "dir/dir2/HHH.txt"
INF : Renamed successfully : "dir/AAA.jpg" -> "dir/20060716_125913.jpg"
INF : Renamed successfully : "dir/BBB.jpg" -> "dir/20060716_125939.jpg"
INF : Renamed successfully : "dir/dir2/FFF.jpg" -> "dir/dir2/20060716_182905.jpg"
INF : Renamed successfully : "dir/dir2/EEE.jpg" -> "dir/dir2/20060717_002233.jpg"

ちなみに自力で再帰的な処理を実装しようとして、サブルーチン内でそのサブルーチン自身を呼び出すようなソースを書いてみたら「Deep recursion on subroutine」とかなんとか怒られちゃいました。あらまあ。後、ファイルの拡張子はExif情報のファイルタイプをベースにして生成するようにしても良いかな、と思ったのですが、面倒なのでやめました。拡張子変えるような悪い子は何か意味があって拡張子変えてるはずなので、敢えてそのままに。という言い訳。
この調子で早めに「初めてのPerl」を卒業します!

「初めてのPerl」 9章 (正規表現の利用法)

東京に来てB2Bの通信ミドルウェアの講習会に参加しているのですが、淡々とした説明があまりにも退屈ですごーく眠いbonlifeです。演習を散りばめたら良いのに今日は講義Onlyですよ…。ということで、帰ってきてPerlの復習をしています。演習問題メモもついに9章「正規表現の利用法」です。

  • m//を使ったマッチング
  • オプション修飾子
  • 結合演算子
  • マッチ変数
  • s///を使った置換
  • split演算子
  • join関数

といった感じの内容がサラッと説明されています。エスケープを積み重ねて大文字、小文字を自由自在に操れるのにはビックリしました。(148,149ページ参照)ということで、9章の演習問題のbonlife的解答です。
ex9-1.pl

  • $whatに入っているものが3回連続して現れるものいマッチするようなパターンを書く
  • もし$whatがfred|barneyだったら、fredfredbarneyなどにマッチすること
#! perl -w
use strict;
my $what = 'fred|barney';
print "Please input some words : \n";
while (<>) {
	chomp;
	if (/($what){3}/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex9-1.pl
Please input some words :
fred
No match.
barney
No match.
fredfredbarney
Matched : | <fredfredbarney> |
barneyfredfred
Matched : | <barneyfredfred> |
barneybarneybarney
Matched : | <barneybarneybarney> |
^Z

解答例を見て気づいたことは特になし。同じ。
ex9-2.pl

  • perlfunc.podファイルの中を探して、=itemで始まり、その次に何個かの空白文字が続き、さらにPerl識別子名(英数字と下線で構成されるが、先頭は数字以外)が続く行を見つけ出すプログラムを書く
  • ダイヤモンド演算子を使う
  • プログラムが識別子名を見つけるたびに表示
#! perl -w
use strict;
while (<>) {
	if (/^=item\s+([A-Z_]\w*)/i) {
		print "$1\n";
	}
}

出力結果は以下の通り。

ex9-2.pl "C:\Perl\lib\pod\perlfunc.pod"
Functions
Regular
Numeric
(中略)
write
write
y

解答例を見て気づいたことは特になし。同じ。
ex9-3.pl

  • 問題2のプログラムを改造して、=item行に3回以上現れた識別子名だけを、現れた回数とともに表示させる
#! perl -w
use strict;
my %word_count;
while (<>) {
	if (/^=item\s+([A-Z_]\w*)/i) {
		$word_count{$1} += 1;
	}
}
foreach my $word ( sort keys %word_count ) {
	if ( $word_count{$word} >= 3 ) {
		print "\"$word\" appears $word_count{$word} times in \"$0\".\n";
	}
}

出力結果は以下の通り。

ex9-3.pl "C:\Perl\lib\pod\perlfunc.pod"
"Functions" appears 9 times in "C:\test\perl\ex9-3.pl".
"Keywords" appears 4 times in "C:\test\perl\ex9-3.pl".
"chomp" appears 3 times in "C:\test\perl\ex9-3.pl".
(中略)
"syswrite" appears 3 times in "C:\test\perl\ex9-3.pl".
"use" appears 5 times in "C:\test\perl\ex9-3.pl".
"write" appears 3 times in "C:\test\perl\ex9-3.pl".

解答例を見て気づいたことは特になし。ほぼ同じ。英語の表現や3個以上の表現が違うぐらいですね。
という感じで9章の演習問題を解きましたが、すでに17章まで読み終わっているのです。演習問題もサクサク解いて一巡目を早めに終わらせておこうと思います。とか言いつつ、Rubyの勉強も始めちゃいます!本も買っちゃいましたので。

たのしいRuby 第2版 Rubyではじめる気軽なプログラミング

たのしいRuby 第2版 Rubyではじめる気軽なプログラミング

「初めてのPerl」 7章 (正規表現の基本)

男子サッカー日本代表は、「ジーコジャパン」、「オシムジャパン」、「反町ジャパン」って感じで「監督名ジャパン」と呼ばれるのに、女子サッカーは「なでしこジャパン」と呼ばれていることにすごく違和感を感じているbonlifeです。Perlの勉強、それなりに順調です。次々と進めてRubyの勉強に着手したいところ。(という欲張りはあまり良くないのでしょうか。)さて、7章では正規表現の基本について説明されています。Perlでは「パターン」と言うらしいです。スラッシュ(/)で囲んでパターンを指定し、if文などで真偽を判断します。メタキャラクタの説明も少し。ドット(.)は改行文字を除いたあらゆる文字1個にマッチします。量指定子についての説明もありました。アスタリスク(*)は直前のもの0回以上にマッチし、プラス記号(+)は直前のものの1回以上にマッチします。後は、カッコ()でグルーピングしたり、縦棒(|)を使ってどちらかにマッチさせる、などなど。秀丸の検索、置換の際にも正規表現は使うので、このあたりはだいたい理解しているつもりです。ということで7章の演習問題のnot模範解答です。
ex7-1.pl

  • fredを含むようなすべての文字列にマッチするパターンを作成し、テスト
#! perl -w
use strict;
print "Please input some words : \n";
while (<>) {
	chomp;
	if (/fred/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex7-1.pl
Please input some words :
fred
Matched : | <fred> |
Fred
No match.
frederick
Matched : | <fred>erick |
Alfred
Matched : | Al<fred> |
^Z

解答例を見て気づいたことは特になし。同じ。
ex7-2.pl

  • 少なくとも1個のaの後ろに任意個のbが続くような文字列にマッチするパターンを作成し、テスト
#! perl -w
use strict;
print "Please input some words : \n";
while (<>) {
	chomp;
	if (/a+b*/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex7-2.pl
Please input some words :
barney
Matched : | b<a>rney |
fred
No match.
abba
Matched : | <abb>a |
dinosaur
Matched : | dinos<a>ur |
^Z

解答例を見て気づいたことは特になし。同じ。
ex7-3.pl

  • 任意個の逆スラッシュの後ろに任意個のアスタリスクが続くような文字列にマッチするパターンを作成し、テスト
#! perl -w
use strict;
print "Please input some words : \n";
while (<>) {
	chomp;
	if (/\\*\**/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex7-3.pl
Please input some words :
a
Matched : | <>a |
a
C:\test\perl>ex7-3.pl
Please input some words :
\\**
Matched : | <\\**> |
fred
Matched : | <>fred |
barney \\\***
Matched : | <>barney \\\*** |
*wilma\
Matched : | <*>wilma\ |
^Z

解答例を見て気づいたことは特になし。同じ。
ex7-4.pl

  • wilmaを含むようなすべての入力行を表示するプログラムを書く
  • 大文字で始まるWilmaにもマッチさせる
#! perl -w
use strict;
while (<>) {
	chomp;
	if (/(^|\s)[wW]ilma([^\w]|$)/) {
		print "$_\n";
	} else {
	}
}

引数として渡すサンプルテキスト

  • wilma.txt
Wilma always sleeps.
Am I Wilman?
No, I'm Wilma.
WILMA is so big!
Oh, small wilma...

出力結果は以下の通り。

ex7-4.pl wilma.txt
Wilma always sleeps.
No, I'm Wilma.
Oh, small wilma...

解答例を見て気付いたことは以下の通り。

  • ここではあまり難しく考える必要はなかったようです (解答例では/(w|W)ilma/)
  • elseは不要

ex7-5.pl

  • wilmaとfredの両方が含まれている行を表示するプログラムを書く
#! perl -w
use strict;
while (<>) {
	chomp;
	if (/(^|\s)[wW]ilma([^\w]|\s).*[fF]red([^\w]|$)|(^|\s)[fF]red([^\w]|\s).*[wW]ilma([^\w]|$)/) {
		print "$_\n";
	} else {
	}
}

引数として渡すサンプルテキスト

  • wilma_and_fred.txt
wilma and fred
WILMA AND FRED
Wilma and Fred
wilmafred
wilma! and fred!
awilma afred

出力結果は以下の通り。

ex7-5.pl wilma_and_fred.txt
wilma and fred
Wilma and Fred
wilma! fred!

解答例を見て気付いたことは以下の通り。

  • if文のネストで2回判断する方法でも対応可能
  • elseは不要

このくらいのレベルであれば特に迷うこともなく書くことができますね。正規表現は極めようとするとすごく大変そうですが、ちょっと使う分には結構イージーです。とか言ってますが、私の場合、見慣れるまでに結構時間がかかりましたが(苦笑)。

「初めてのPerl」 8章 (正規表現の詳細)

講習会(研修のようなもの)に参加するために8月8日から東京に行くのですが、なんだか会社の人たちからは早めに夏休みを取っているように思われているbonlifeです。納得が行きません…。さてさて、「初めてのPerl」の8章は7章に引き続き正規表現についての説明です。

  • 文字クラス (ブラケット[]の間に文字を並べたもの)
  • 文字クラスのショートカット (「ワード」は\w、空白文字は\sなど)
  • ショートカットの否定 (非数字は[^\d]など)
  • 汎用の量指定子 ({3,5}で3回以上5回以下の繰り返し)
  • アンカー (文字列の先頭を表す^や末尾を表す$)
  • ワードアンカー (\b単語\b)
  • カッコによる記憶、後方参照
  • 優先順位

などなど結構盛り沢山です。正規表現素人でもこの章の内容をマスターすれば結構な正規表現使いになれそうです。私の場合、体系的に勉強していなかったのでワードアンカー(\b)を知りませんでしたよ…。また、後方参照時、左カッコから順に1から数字が割り当てられる、というのは勉強になりました。そんなこんなで、8章の演習問題のnot模範解答です。
ex8-1.pl

  • ワードfredまたはwilmaがあり、次に何個かの空白文字があり、その後ろにワードflintstoneがあるような行にだけマッチするパターンを作成し、テスト
#! perl -w
use strict;
while (<>) {
	chomp;
	if (/([fF]red|[wW]ilma)\s+flintstone/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex8-1.pl
Please input some words :
I am fred flintstone
Matched : | I am <fred flintstone> |
You are wilma     flintstone
Matched : | You are <wilma     flintstone> |
He is afred flintstone
Matched : | He is a<fred flintstone> |

解答例を見て気付いたことは以下の通り。

  • 完全にワードとして扱うのを忘れておりました (パターンの先頭、末尾に\bが必要)

ex8-2

  1. /"([^"]*)"/
  2. /^0?[0-3]?[0-7]{1,2}$/
  3. /^\b[\w.]{1,12}\b$/

解答は以下の通り。

  1. ダブルクォートの間にダブルクォートではない文字が0回以上現れるもの (HTMLタグの属性値など)
    つまり、ダブルクォートに囲まれた文字列
  2. 0回、または1回の0の後、0〜3が0回、または1回出現し、その後、0-7が1回から2回繰り返されて終わるもの
    8進数っぽい
  3. スペースに区切られた、数字またはアルファベット1文字の後、任意の1文字の1回から12回の繰り返し
    1〜12文字の文字列 (.あり)

解答例を見て気付いたことは以下の通り。

  • 2は勘が当たっていてビックリ
  • 3は\bで挟まれているので文字列の先頭と末尾にはドットを置けない

ex8-3.pl

  • スカラー変数名だけを含むような文字列にマッチするパターンを作成
#! perl -w
use strict;
print "Please input some words : \n";
while (<>) {
	chomp;
	if (/^\$[A-Za-z_]\w*$/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex8-3.pl
Please input some words :
$wilma
Matched : | <$wilma> |
wilma
No match.
$0
No match.
^Z

解答例を見て気づいたことは特になし。同じ。とか言いつつ、最初、2文字目以降は数字もO.K.だということを忘れておりました。いくつか文字列を入力してる時に気づいて慌てて修正です。(慌てる必要なんて全くないのですが。)
ex8-4.pl

  • 同じワードが連続して2回以上出現する行にマッチするパターンを作成
#! perl -w
use strict;
print "Please input some words : \n";
while (<>) {
	chomp;
	if (/\b(\w+)\b(\s+\1)+\b/) {
		print "Matched : | $`<$&>$' |\n";
	} else {
		print "No match.\n";
	}
}

出力結果は以下の通り。

ex8-4.pl
Please input some words :
Paris in the the spring
Matched : | Paris in <the the> spring |
I think that that is the problem
Matched : | I think <that that> is the problem |
I think that that   that is the problem
Matched : | I think <that that   that> is the problem |
This is a test
No match.
This shouldn't match, according to the theory of regular expressions
No match.

解答例を見て気づいたことは以下の通り。

  • 2個目の\bは不要 (\w+が単語にマッチする)

最初、3回以上の繰り返しの対応が考慮できておらず、何度か修正しましたよ。このレベルになってくるとさすがにサラッと書けないですね…。正規表現の章ではないところでこの問題が出ていたら、1行ずつ取り込んでスペース区切りで分解して配列に格納し、値を1語ずつ比較するようなスクリプト書いてただろうなぁ、とか思ったりしました。正規表現ってやっぱり便利です。そろそろ細々とした間違いも出てきましたので、次の章からはもう少し慎重に演習問題を解いていこうと思います!