|
文字列に対して、EUC 全角(漢字)文字に完全対応したワードの置換処理を行います。 s/$word/$replace/g; でもある程度は可能な機能ですが、EUC 漢字が含まれているテキストの場合、 単純な１バイト処理だと EUC の１バイト、２バイト目の判別がつかないため、間違った置換を 行ってしまう場合があります。 本関数は、そのような場合でも正しく置換できます。 ４番目の引数に０以外を指定しない場合は、Perlのメタ文字で使用する文字の前にバックスラッシュ を付加し、自動的にメタ文字を無効化します。 この場合は、正規表現が使えませんので注意が必要です。 この HTML 上では漢字がシフトJIS になっていますが、本来は EUC 向けとなっています。 シフトJISでも、半角カナなどがなければある程度動作しますが、若干の修正を行ったほうが 良いでしょう。 |
# 漢字完全対応ワード置換処理(EUC 向け,シフトJISでもある程度動作)
# s/$word/$replace/g; の代用品(可能性は低いが、漢字があると正しく動作しない可能性あり)
sub replace_allword
{
my($wk) = $_[0];
my($wd) = $_[1];
my($rp) = $_[2];
# 引数３が０ならば、メタ変換を実行
if ($_[3] = 0) {
# メタ文字の変換
# \ / | ( ) [ { ^ $ * + ? .
# 追加分 -
$wd =~ s/([\\\/\|\(\)\[\{\^\$\*\+\?\.\-])/\\\1/g;
$rp =~ s/([\\\/\|\(\)\[\{\^\$\*\+\?\.\-])/\\\1/g;
}
if (ord($wd) < 128) {
# サーチ文字の先頭が半角から始まるなら特に問題なし
$wk =~ s/$wd/$rp/g;
} else {
# 先頭が全角(２バイト文字)からの場合は要注意
my($sl) = length($wd);
my($lm1) = length($wk);
for (my($i) = 0 ; $i < $lm1 ; ) {
my($one) = substr($wk, $i, $sl); # 比較/置換する分だけ取り出し
if ( ord($one) >= 128 ) {
# 2 byte code
if ( $one =~ s/^$wd/$rp/ ) {
substr($wk, $i, $sl) = $one; # 置換した結果を戻す
$lm1 = length($wk); # 文字列長の修正
$i += length($one);
} else {
# 置換しない場合はそのまま進む
$i += 2;
}
} else {
# 1 byte code
$i++;
}
}
}
return ($wk);
}