]> dxcluster.net Git - spider.git/blob - perl/BadWords.pm
remove warning message about exiting a subroutine via next
[spider.git] / perl / BadWords.pm
1 #
2 # Search for bad words in strings
3 #
4 # Copyright (c) 2000 Dirk Koopman
5 #
6 # $Id$
7 #
8
9 package BadWords;
10
11 use strict;
12
13 use DXUtil;
14 use DXVars;
15 use IO::File;
16
17 use vars qw(%badwords $fn);
18
19 $fn = "$main::data/badwords";
20 %badwords = ();
21
22 # load the badwords file
23 sub load
24 {
25         my @out;
26         return unless -e $fn;
27         my $fh = new IO::File $fn;
28         
29         if ($fh) {
30                 %badwords = ();
31                 while (<$fh>) {
32                         chomp;
33                         next if /^\s*\#/;
34                         my @list = split " ";
35                         for (@list) {
36                                 $badwords{lc $_}++;
37                         }
38                 }
39                 $fh->close;
40         } else {
41                 my $l = "can't open $fn $!";
42                 dbg('err', $l);
43                 push @out, $l;
44         }
45         return @out;
46 }
47
48 # check the text against the badwords list
49 sub check
50 {
51         return grep { $badwords{$_} } split(/\b/, lc shift);
52 }
53
54 1;