view release on metacpan or  search on metacpan

Words.pm  view on Meta::CPAN

  GPL2V2

	=========================================

=cut

my @changing = ('ahole','anus','ash0le','ash0les','asholes','ass','Ass Monkey','Assface',
'assh0le','assh0lez','asshole','assholes','assholz','asswipe','azzhole','bassterds','bastard',
'bastards','bastardz','basterds','basterdz','Biatch','bitch','bitches','Blow Job','boffing',
'butthole','buttwipe','c0ck','c0cks','c0k','Carpet Muncher','cawk','cawks','Clit','cnts','cntz',
'cock','cockhead','cock-head','cocks','CockSucker','cock-sucker','crap','cum','cunt','cunts',
'cuntz','dick','dild0','dild0s','dildo','dildos','dilld0','dilld0s','dominatricks','dominatrics',
'dominatrix','dyke','enema','f u c k','f u c k e r','fag','fag1t','faget','fagg1t','faggit',
'faggot','fagit','fags','fagz','faig','faigs','fart','flipping the bird','fuck','fucker',
'fuckin','fucking','fucks','Fudge Packer','fuk','Fukah','Fuken','fuker','Fukin','Fukk','Fukkah',
'Fukken','Fukker','Fukkin','g00k','gay','gayboy','gaygirl','gays','gayz','God-damned','h00r',
'h0ar','h0re','hells','hoar','hoor','hoore','jackoff','jap','japs','jerk-off','jisim','jiss','jizm',
'jizz','knob','knobs','knobz','kunt','kunts','kuntz','Lesbian','Lezzian','Lipshits','Lipshitz',
'masochist','masokist','massterbait','masstrbait','masstrbate','masterbaiter','masterbate',
'masterbates','Motha Fucker','Motha Fuker','Motha Fukkah','Motha Fukker','Mother Fucker',
'Mother Fukah','Mother Fuker','Mother Fukkah','Mother Fukker','mother-fucker','Mutha Fucker',
'Mutha Fukah','Mutha Fuker','Mutha Fukkah','Mutha Fukker','n1gr','nastt','nigger','nigur','niiger',
'niigr','orafis','orgasim','orgasm','orgasum','oriface','orifice','orifiss','packi','packie',
'packy','paki','pakie','paky','pecker','peeenus','peeenusss','peenus','peinus','pen1s','penas',
'penis','penis-breath','penus','penuus','Phuc','Phuck','Phuk','Phuker','Phukker','polac','polack',
'polak','Poonani','pr1c','pr1ck','pr1k','pusse','pussee','pussy','puuke','puuker','queer','queers',
'queerz','qweers','qweerz','qweir','recktum','rectum','retard','sadist','scank','schlong','screwing',
'semen','sex','sexy','Sh!t','sh1t','sh1ter','sh1ts','sh1tter','sh1tz','shit','shits','shitter',
'Shitty','Shity','shitz','Shyt','Shyte','Shytty','Shyty','skanck','skank','skankee','skankey',
'skanks','Skanky','slut','sluts','Slutty','slutz','son-of-a-bitch','tit','turd','va1jina','vag1na',
'vagiina','vagina','vaj1na','vajina','vullva','vulva','w0p','wh00r','wh0re','whore','xrated','xxx');

#################
#
# assorted additional words

my @assorted = (
'batty man', qw(
bender
bollocks
bumboy
cracker
cumsucker
douchebag
fucktwat
ho
honky
jackass),
'joey semen',
'joey deacon', qw(
knobcheese
minge
minger
mong
munter
pickle
rimmer
spakka
spaz
taint
tool
));

my $ref;	# not thread safe

sub once {
  return $ref if $ref;
  &new;
}

sub new {
  $ref = &newthrd;
}

sub newthrd {
  my $proto = shift;
  my $class = ref $proto || $proto || __PACKAGE__;
  my $wr = ref($_[0]) ? $_[0] : [@_];
  my @add = grep { defined $_ && $_ ne '' } @$wr;	# strip empty and undefined entries
  my %uniq = map { lc($_) => 1 } (@google,@urbanos,@changing,@assorted,@add);
  my @list = sort keys %uniq;
  bless \@list, $class;
}

my $passes;
sub remove {
  my $wr = shift;
  my $x = ref($_[0]) ? $_[0] : [@_];
  return $wr unless @$x;	# empty or missing list
  my @list = sort grep { defined $_ && $_ ne '' && ($_ = lc $_) }@$x;
# attempt to remove words in a single pass
# this will fail if the 'remove' word in not
# in the bad list. Hence the while loop
  $passes = 0;			# for debug
LIST:
  while (defined (my $s = shift @list)) {
    $passes++;
    for (my $i=0;$i< @$wr;) {
      if ($s eq $wr->[$i]) {
	splice @$wr,$i,1;
	last LIST unless defined ($s = shift @list);	# end of list?
      } else {
	$i++;
      }
    }
  }
  $wr;
}

sub _passes { return $passes };

sub noregex {
  my($wr,$regex) = @_;
  return $wr unless defined $regex;
  for (my $i=0;$i< @$wr;) {
    if ($wr->[$i] =~ /$regex/) {
      splice @$wr,$i,1;
      next;
    }
    $i++;