Perl 禁止語句

質問

テキストの中に禁止語句一覧があります。

それと一致した場合、エラーを返すのですが、
現在のコードですと、
完全一致で、これを部分一致にする
方法を教えてください。
またコードの指摘があればよろしくお願いいたします！

◆ngword.txt◆
あい
いう
うえ
えお
・
・
・
1000行ほど（もっとあるかもしれません）

◆test.pl◆「UTF-8」
#/usr/bin/perl
use Encode;

my $Name = "え";
$Name = encode('cp932', decode('UTF-8', $Name));

open my $fh, '<', 'ngword.txt';
chomp(@ngword = <$fh>);

if(&ban($Name, \@ngword)) {
print "error\n";
}

sub ban
{
my $body = shift;
my $word = shift;
$body =~ s/(\x0d\x0a|\x0a|\x0d|\n|\s|\x81\x41|\xff)//g;
return map { $body =~ /$_/m } @$word;
}

回答No.1

Gotthold · ベストアンサー

> 現在のコードですと、
> 完全一致で、これを部分一致にする
> 方法を教えてください。
現在のコードは部分一致（もっと正確には正規表現の部分一致）に見えます。

> またコードの指摘があればよろしくお願いいたします！
いくつか問題があります。

> my $Name = "え";
> $Name = encode('cp932', decode('UTF-8', $Name));
ソースコードをUTF-8で書くのは良い作法ですが、
それなら
use utf8;
を記載した方が良いです。
use utf8;
を記載すると、
ソースコード中の文字列リテラルが全てdecodeされた扱いになります。

#こう書かなくても
my $Name = decode_utf8("え");

#これでOK
use utf8;
my $Name = "え";

また、せっかくデコードした$NameをなぜかCP932にエンコードしていますが、
エンコードしてしまうとperlはその内容を文字列と解釈できずバイナリ列と解釈します。
その結果、 例えば
・Name = "コ" （文字コード0x8352）
・禁止文字 = "R" （文字コード0x52）
などの組み合わせで、コに禁止文字Rが含まれていると解釈されてしまいます。

このようなことを避けるために、
文字列比較などはデコードした文字列同士で行いましょう。

> return map { $body =~ /$_/m } @$word;
文字列検索に正規表現を使っています。
このため禁止ワードに正規表現で特殊な意味を持つ . や * などが含まれていると
正規表現として扱われてしまいます。
これは意図通りですか？

また、正規表現のmオプションを使っていますが、意味を理解して使っていますか？
（mオプションは正規表現の ^ や $ の挙動を変えるオプションです。）

部分一致、完全一致のやり方はコード見た方が早いと思うので
サンプルを見てください。

#======サンプル=======
#/usr/bin/perl
use utf8;
use strict;
use Encode;

my $Name = "あいう";

open my $fh, '<:encoding(cp932)', 'ngword.txt'; # perlIOレイヤで自動的にdecode 'cp932'
chomp(my @ngword = <$fh>);
close $fh;

#print前のencodeは省略
print "ban1\n" if(&ban1($Name, \@ngword));
print "ban2\n" if(&ban2($Name, \@ngword));
print "ban3\n" if(&ban3($Name, \@ngword));
print "ban4\n" if(&ban4($Name, \@ngword));

sub ban1
{
my $body = shift;
my $word = shift;
foreach my $w (@$word){
return 1 if (index($body, $w) >= 0); #部分一致
}
return 0;
}

sub ban2
{
my $body = shift;
my $word = shift;
foreach my $w (@$word){
return 1 if ( $body eq $w ); #完全一致
}
return 0;
}

sub ban3
{
my $body = shift;
my $word = shift;
my $word_re = join '|', map { quotemeta } @$word;
return ($body =~ m/$word_re/); #部分一致
}

sub ban4
{
my $body = shift;
my $word = shift;
my $word_re = join '|', map { quotemeta } @$word;
return ($body =~ m/\A(?:$word_re)\z/); #完全一致
}

お礼

お返事が遅くなり申し訳ございません。

いろいろなパターンを作ってくださりありがとうございます！

実行確認できました！