]> scm.dxcluster.org Git - spider.git/blob - perl/BadWords.pm
add module
[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 DXHash;
16 use IO::File;
17
18 use vars qw($badword);
19
20 my $oldfn = "$main::data/badwords";
21 $badword = new DXHash "badword";
22
23 use vars qw($VERSION $BRANCH);
24 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
25 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
26 $main::build += $VERSION;
27 $main::branch += $BRANCH;
28
29 # load the badwords file
30 sub load
31 {
32         my @out;
33         return unless -e $oldfn;
34         my $fh = new IO::File $oldfn;
35         
36         if ($fh) {
37                 while (<$fh>) {
38                         chomp;
39                         next if /^\s*\#/;
40                         my @list = split " ";
41                         for (@list) {
42                                 $badword->add($_);
43                         }
44                 }
45                 $fh->close;
46                 $badword->put;
47                 unlink $oldfn;
48         } else {
49                 my $l = "can't open $oldfn $!";
50                 dbg($l);
51                 push @out, $l;
52         }
53         return @out;
54 }
55
56 # check the text against the badwords list
57 sub check
58 {
59         my $s = uc shift;
60         
61         for (split(/\s+/, $s)) {
62                 s/[^\w]//g;
63                 return $_ if $badword->in($_);
64                 s/\'?S$//;
65                 return $_ if $badword->in($_);
66         }
67         
68         # look for a few of the common ones with spaces and stuff
69         if ($s =~ /F[\s\W]*U[\s\W]*C[\s\W]*K/) {
70                 return "FUCK";
71         } elsif ($s =~ /C[\s\W]*U[\s\W]*N[\s\W]*T/) {
72                 return "CUNT";
73         } elsif ($s =~ /W[\s\W]*A[\s\W]*N[\s\W]*K/) {
74                 return "WANK";
75         } elsif ($s =~ /C[\s\W]*[0O][\s\W]*C[\s\W]*K/) {
76                 return "COCK";
77         } elsif ($s =~ /S[\s\W]*H[\s\W]*[I1][\s\W]*T/) {
78                 return "SHIT";
79         }
80         
81         return ();
82 }
83
84 1;