こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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;
}

投稿日時 - 2017-04-12 13:43:07

QNo.9316685

困ってます

質問者が選んだベストアンサー

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


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

> 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/); #完全一致
}

投稿日時 - 2017-04-14 00:45:21

お礼

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

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

実行確認できました!

投稿日時 - 2017-04-19 12:09:13

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)