From c77ea09e91a5f7c3052e3e30dfb48fcaad1e0dcd Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Thu, 4 Oct 2001 15:52:12 +0000
Subject: [PATCH] finally fixed the regexes

---
 cmd/dx.pl             | 11 ++++++-----
 data/badw_regex.issue |  2 +-
 perl/BadWords.pm      | 26 +++++++++++++++-----------
 3 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/cmd/dx.pl b/cmd/dx.pl
index 0b2ece1d..1d09a476 100644
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -17,6 +17,12 @@ my @out;
 my $valid = 0;
 return (1, $self->msg('e5')) if $self->remotecmd;
 
+my @bad;
+if (@bad = BadWords::check($line)) {	
+	$self->badcount(($self->badcount||0) + @bad);
+	return (1, $self->msg('e17', @bad));
+}
+
 # do we have at least two args?
 return (1, $self->msg('dx2')) unless @f >= 2;
 
@@ -93,11 +99,6 @@ if ($spotted le ' ') {
 
 return (1, @out) unless $valid;
 
-my @bad;
-if (@bad = BadWords::check($line)) {	
-	$self->badcount(($self->badcount||0) + @bad);
-	return (1, $self->msg('e17', @bad));
-}
 
 # Store it here (but only if it isn't baddx)
 if ($DXProt::baddx->in($spotted)) {
diff --git a/data/badw_regex.issue b/data/badw_regex.issue
index 489da617..e38b4c8d 100644
--- a/data/badw_regex.issue
+++ b/data/badw_regex.issue
@@ -8,7 +8,7 @@ cock c0ck
 wank
 shit sh1t
 piss p1ss
-bolock b0lock b0lock
+bolock b0lock b0l0ck
 toser t0ser
 tospot t0spot t0sp0t
 arse
diff --git a/perl/BadWords.pm b/perl/BadWords.pm
index db33d7a1..b598c385 100644
--- a/perl/BadWords.pm
+++ b/perl/BadWords.pm
@@ -17,7 +17,7 @@ use DXDebug;
 
 use IO::File;
 
-use vars qw($badword @regex);
+use vars qw($badword $regexcode);
 
 my $oldfn = "$main::data/badwords";
 my $regex = "$main::data/badw_regex";
@@ -61,11 +61,10 @@ sub load
 sub create_regex
 {
 	my @out;
-	@regex = ();
-	
 	my $fh = new IO::File $regex;
 	
 	if ($fh) {
+		my $s = "sub { my \$str = shift; my \@out; \n";
 		while (<$fh>) {
 			chomp;
 			next if /^\s*\#/;
@@ -75,12 +74,18 @@ sub create_regex
 				# and repeated characters in it
 				my $w = uc $_;
 				my @l = split //, $w;
-				my $e = join '+[\s\W]+', @l;
-				my $s = eval qq{sub { return \$_[0] =~ /$e+/ ? '$w' : () } };
-				push @regex, $s unless $@;
-				dbg("create_regex: $@") if $@;
+				my $e = join '+[\s\W]*', @l;
+				$s .= "push \@out, \$1 if \$str =~ /($e)/;\n";
 			}
 		}
+		$s .= "return \@out;\n}";
+		$regexcode = eval $s;
+		dbg($s) if isdbg('badword');
+		if ($@) {
+			@out = ($@);
+			dbg($@);
+			return @out;
+		}
 		$fh->close;
 	} else {
 		my $l = "can't open $regex $!";
@@ -96,10 +101,9 @@ sub check
 {
 	my $s = uc shift;
 	my @out;
-	
-	for (@regex) {
-		push @out, &$_($s);
-	}
+
+	dbg($s) if isdbg('badword');
+	push @out, &$regexcode($s) if $regexcode;
 	
 	return @out if @out;
 	
-- 
2.34.1