X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FBadWords.pm;h=b598c385d4e940f45716a4f2f35c303ad9b46e1e;hb=c77ea09e91a5f7c3052e3e30dfb48fcaad1e0dcd;hp=db33d7a1c4ebaeb34127c79bb1f5c1463dc35463;hpb=0ab700a4725f5fedc0ad119f8ffd1d66cd02e26f;p=spider.git diff --git a/perl/BadWords.pm b/perl/BadWords.pm index db33d7a1..b598c385 100644 --- a/perl/BadWords.pm +++ b/perl/BadWords.pm @@ -17,7 +17,7 @@ use DXDebug; use IO::File; -use vars qw($badword @regex); +use vars qw($badword $regexcode); my $oldfn = "$main::data/badwords"; my $regex = "$main::data/badw_regex"; @@ -61,11 +61,10 @@ sub load sub create_regex { my @out; - @regex = (); - my $fh = new IO::File $regex; if ($fh) { + my $s = "sub { my \$str = shift; my \@out; \n"; while (<$fh>) { chomp; next if /^\s*\#/; @@ -75,12 +74,18 @@ sub create_regex # and repeated characters in it my $w = uc $_; my @l = split //, $w; - my $e = join '+[\s\W]+', @l; - my $s = eval qq{sub { return \$_[0] =~ /$e+/ ? '$w' : () } }; - push @regex, $s unless $@; - dbg("create_regex: $@") if $@; + my $e = join '+[\s\W]*', @l; + $s .= "push \@out, \$1 if \$str =~ /($e)/;\n"; } } + $s .= "return \@out;\n}"; + $regexcode = eval $s; + dbg($s) if isdbg('badword'); + if ($@) { + @out = ($@); + dbg($@); + return @out; + } $fh->close; } else { my $l = "can't open $regex $!"; @@ -96,10 +101,9 @@ sub check { my $s = uc shift; my @out; - - for (@regex) { - push @out, &$_($s); - } + + dbg($s) if isdbg('badword'); + push @out, &$regexcode($s) if $regexcode; return @out if @out;