+ else {
+ my $l = "BadWords: can't open $bwfn $!";
+ dbg($l);
+ push @out, $l;
+ return @out;
+ }
+
+ # do the same for badw_regex
+ my $regexfn = localdata("badw_regex");
+ filecopy("$main::data/badw_regex.gb.issue", $regexfn) unless -e $regexfn;
+ dbg("BadWords: Using old style badw_regex file");
+ $fh = new IO::File $regexfn;
+
+ if ($fh) {
+ while (<$fh>) {
+ chomp;
+ next if /^\s*\#/;
+ next if /^\s*$/;
+ push @inw, split /\s+/, uc $_;
+ }
+ $fh->close;
+ }
+ else {
+ my $l = "BadWords: can't open $regexfn $!";
+ dbg($l);
+ push @out, $l;
+ return @out;
+ }
+
+ ++$wasold;
+ }
+
+ # catch most of the potential duplicates
+ @inw = sort @inw;
+ for (@inw) {
+ add_regex($_);
+ }
+
+ # create the master regex
+ generate_regex();
+
+ # use new style from now on
+ put() if $wasold;
+
+
+ return @out;
+}
+
+sub generate_regex
+{
+ my $res;
+ @relist = sort {$a->[0] cmp $b->[0]} @relist;
+ for (@relist) {
+ $res .= qq{\\b(?:$_->[1]) |\n};
+ }
+ $res =~ s/\s*\|\s*$//;
+ $regex = qr/\b($res)/x;
+}
+
+
+sub _cleanword
+{
+ my $w = uc shift;
+ $w =~ tr/01/OI/; # de-leet any incoming words
+ my $last = ''; # remove duplicate letters (eg BOLLOCKS > BOLOCKS)
+ my @w;
+ for (split //, $w) {
+ next if $last eq $_;
+ $last = $_;
+ push @w, $_;