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;