Perlで可変長の先読み戻り読みができない

Perlスクリプトで、以下のような置換をしようとしています。

置換前　piyo … fuga … piyo 【piyo … fuga … piyo … hoge … piyo】 fuga … piyo
置換後　【ぴよ】 … fuga … 【ぴよ】 【piyo … fuga … piyo … hoge … piyo】 fuga … 【ぴよ】

【】が入れ子にならないように、【】の外の部分でだけマッチ、置換しようと正規表現を考えていたのですが、いくらやってもできません。調べていたら、Perlでは可変長の先読み戻り読みをサポートしていないらしいことがわかりました。

正規表現一つでも、複数行のスクリプトでも構いません。どのようにすればよいでしょうか。

No.1 回答者： kumoz 回答日時： 2014/05/28 14:02

オプションでカッコの部分を読み取ってしまえば、カッコの外側のみの piyo だけを置き換えることができると思います。

なお、次のコードは、文字コードの影響を受けないように ASCII のみを使っています。

$str = 'piyo ... fuga ... piyo [piyo ... fuga ... piyo ... hoge ... piyo] fuga ... piyo';
$str =~ s/((?:\[.*?\].*?)*)piyo/$1\[PIYO\]/g;
print "$str\n";

この回答への補足

作った例が忠実でなく、わかりにくかったかもしれません。実際には、全角文字『と』で区切りたいと思っています。

補足日時：2014/05/30 12:09

この回答へのお礼

ありがとうございました。正規表現は難しいです。

お礼日時：2014/05/30 12:09

No.2 回答者： ahoo_chieokure 回答日時： 2014/05/28 15:02

下のようにすると最後の文字列がおかしくなりますよ。

$str = 'piyo ... fuga ... piyo [piyo ... fuga ... piyo ... hoge ... piyo] fuga ... piyo [piyo]';

↓

[PIYO] ... fuga ... [PIYO] [piyo ... fuga ... piyo ... hoge ... piyo] fuga ... [PIYO] [[PIYO]]

この回答へのお礼

ありがとうございました。

お礼日時：2014/05/30 12:09

No.3 回答者： kumoz 回答日時： 2014/05/28 15:29

No.2 さんの指摘通り、前回の解答は作りが雑で少し欠陥があります。

最後の piyo がない場合も、カッコ内の piyo を置き換えてしまいます。次のように、変更させてもらいます。

$str =~ s/\G((?:[^][]*?|\[[^][]*\])*?)piyo/$1\[PIYO\]/g;

この回答への補足

自分の環境ではPerlでやることはできないのでしょうか。
可変長をサポートしている他の言語と組み合わせたり、どんな形でも実現できればよいのですが。

補足日時：2014/05/30 12:11

この回答へのお礼

ありがとうございました。全角文字『』を使用しているためか、以下のようなメッセージが出てしまいました。
Complex regular subexpression recursion limit

お礼日時：2014/05/30 12:10

No.4 回答者： Ogre7077 回答日時： 2014/05/28 17:18

この手を正規表現だけで頑張るのは感心しません

読みにくくて直しづらいコードになりがちなので

というわけで素直に複数行で解決しましょう

$s = "piyo … fuga … piyo <piyo … fuga … piyo … hoge … piyo> fuga … piyo";
$t = "";
foreach ($s =~ /[^<>]+|<.*?>/g) {
s/piyo/<PIYO>/g unless(/</);
$t .= $_;
}
print $t;

この回答への補足

全角文字『』を使用しているせいか、私の環境ではout of memoryとなってしまいました。
私の実際のスクリプトは、
foreach (@file_str){
$sentence[$i] =~ s/問題の箇所/g;
}
というようなものです。

補足日時：2014/05/30 12:10

この回答へのお礼

ありがとうございました。
Perl初心者のため、いただいたスクリプトを全部理解しないまま自分の状況に置き換えて試してみましたが、our of memory になってしまいました。

お礼日時：2014/05/30 12:09

No.5 回答者： kumoz 回答日時： 2014/05/30 14:34

> Complex regular subexpression recursion limit

上記のエラーは、正規表現の部分式が再帰の上限を超えた場合に出力されます。大きなファイル全体等、正規表現の対象テキストが大きすぎるのが原因だと思います。while ループで１行ずつ読み込むようにすれば、効率的に処理できるようになります。『 と 』 が行を跨いでいなければ、次のようなコードで処理できると思います。なお、プログラムと入力ファイルはともに UTF-8 と仮定しています。

use strict;
use Encode;
use utf8;
open FH, 'inputfile' or die $!;

while (my $line = <FH>) {
$line = decode 'utf8', $line;
$line =~ s/\G((?:[^『』]|『[^『』]*』)*?)piyo/$1『ぴよ』/g;
$line = encode 'utf8', $line;
print $line;
}

close FH;

正規表現の適用は、対象文字列と正規表現の両方を「UTF-8 内部文字列」にする必要があります。そうでなければ、『 や 』 が１文字として認識されません。

この回答への補足

実際の私のスクリプトは以下のように、document全体を読み込んでから、各行について「ほげ」にマッチすれば、次の行で、別リスト上の語（piyo）の置換をかけるというようなものです（初心者のため、レキシカル変数などおかしなところがあるかもしれませんが、動けばよいと考えています）。
whileでどのように自分のやりたいことを実現できるか考えたいと思います。ご教示があればよろしくおねがいします。

# ファイルオープン（読み込みモード）
my $document = $ARGV[0];
open (my $in,"<:utf8", $document)
or die qq/Can't open file "$document" : $!/;
# 全文を配列として入れる
our @sentence = <$in>;
# tmxファイルクローズ（読み込みモード）
close ($in);

for (my $i=0; $i<=$#sentence; $i++) {
if ($sentence[$i] =~ /ほげ/) {
#その次の行を置換
foreach (@file_str){
$sentence[$i+1] =~ s/問題の箇所/g;
}
}
}

補足日時：2014/05/30 15:45

この回答へのお礼

すばやいご回答ありがとうございます。
なるほどです。
補足入力をご覧いただければと思います。

お礼日時：2014/05/30 15:44

No.6 回答者： kumoz 回答日時： 2014/05/30 21:05

No.5 の補足に書かれたコードを見ると、open 文の引数に "<:utf8" があるのでファイルからの読み込みは「UTF-8 内部文字列」になるのはわかるのですが、/ほげ/ と @file_str が「UTF-8 内部文字列」になっているのか、それとも「UTF-8 バイト文字列」なのかは判断できません。

大丈夫でしょうか？

まずは、No.5 の補足のコードがなぜうまく行かないのか、突き止めることをお奨めします。例えば、/ほげ/ が ASCII 以外の文字を含んでいて「UTF-8 バイト文字列」である場合は、if の内部に入ることはありません。if の内部に入ることが確認できたら、簡単な正規表現を実行してみるとか、いろいろとやれることはあると思います。

なお、while ループで１行ずつ読み込んで処理するには、フラグ的な変数を用いるのも一つの方法です。

my $prev = 0;
while (my $line = <FH>) {
...
if ($prev) {
foreach (@file_str) {
$line =~ ...
}
$prev = 0;
} else {
$prev = 1 if $line =~ /ほげ/;
}
...
}

この回答への補足

お話と関係のある箇所と思われる部分がわかるようにした、スクリプトのほぼ全体は、以下のとおりです。（OSはWindows、元のファイルはすべてutf8で保存してあります）

use strict;
use warnings;
use utf8;
use Encode

binmode STDIN, ':encoding(utf8)';
binmode STDOUT, ':encoding(utf8)';
binmode STDERR, ':encoding(cp932)';

# ドキュメントファイルオープン（読み込みモード）
my $document = $ARGV[0];
open (my $in,"<:utf8", $document)
or die qq/Can't open file "$document" : $!/;
# 全文を配列として入れる
our @sentence = <$in>;
# ファイルクローズ
close ($in);

# リストファイルオープン（読み込みモード）
my $list = 'list.txt';
open (our $list_in_handle,"<:utf8", $list)
or die qq/Can't open file $list : $!/;
#リストファイルの内容を配列に格納
our @list_str = <$list_in_handle>;
# リストファイルクローズ
close ($list_in_handle);

# 置換ファイル作成（追加書き込みモードでオープン）
my $filename = 'filename.txt';
open (our $out_handle,">> $filename");

# ドキュメントファイルの各行について
for (my $i=0; $i<=$#sentence; $i++) {
# 出力してから
print $out_handle Encode::encode("utf8", $sentence[$i]);

# 文字列がマッチすれば
our $hoge = 'source';
if ($sentence[$i] =~ /$hoge/) {
# 次の行を置換
foreach (@file_str){
$sentence[$i+1] =~ s/問題の$_箇所/問題の『$_』箇所/g;
}}}
# 最後に置換ファイルクローズ（略）

「$hoge」の部分は今回はascii文字列です。

補足日時：2014/05/30 22:26

この回答へのお礼

ありがとうございます。
最初にいただいた正規表現でスクリプトが動くこと自体は確認しています（入れ子にはなりましたが）。
いただいたwhileのサンプルスクリプトは私の知識を超えているので、勉強させていただきます。
Perlの内部文字列とバイト文字列について、さきほども検索していましたが、なかなか理解できません。なんとかOJTで理解できるようになれればと思うのですが。
道は遠いですね。

お礼日時：2014/05/30 22:26