8. added default badword and badw_regex tables (as .issue files) which will
activate unless there is one there already.
4. store deleted status across restarts!
5. make callsign checking more rigorous
6. dup check PC49 (kill full)
4. store deleted status across restarts!
5. make callsign checking more rigorous
6. dup check PC49 (kill full)
+7. improved the regex matching of badwords (more efficient, better coverage)
+8. added default badword and badw_regex tables (as .issue files) which will
+activate unless there is one there already.
03Oct01=======================================================================
1. don't allow @WWW to become a 'TO' field...
2. handle @gb7tlh.#35.eu type addresses as well
03Oct01=======================================================================
1. don't allow @WWW to become a 'TO' field...
2. handle @gb7tlh.#35.eu type addresses as well
use DXUtil;
use DXVars;
use DXHash;
use DXUtil;
use DXVars;
use DXHash;
+use vars qw($badword @regex);
my $oldfn = "$main::data/badwords";
my $oldfn = "$main::data/badwords";
+my $regex = "$main::data/badw_regex";
+my $bwfn = "$main::data/badword";
+
+# copy issue ones across
+filecopy("$regex.issue", $regex) unless -e $regex;
+filecopy("$bwfn.issue", $bwfn) unless -e $bwfn;
+
$badword = new DXHash "badword";
use vars qw($VERSION $BRANCH);
$badword = new DXHash "badword";
use vars qw($VERSION $BRANCH);
- return unless -e $oldfn;
my $fh = new IO::File $oldfn;
if ($fh) {
my $fh = new IO::File $oldfn;
if ($fh) {
$fh->close;
$badword->put;
unlink $oldfn;
$fh->close;
$badword->put;
unlink $oldfn;
+ }
+ push @out, create_regex();
+ return @out;
+}
+
+sub create_regex
+{
+ my @out;
+ @regex = ();
+
+ my $fh = new IO::File $regex;
+
+ if ($fh) {
+ while (<$fh>) {
+ chomp;
+ next if /^\s*\#/;
+ my @list = split " ";
+ for (@list) {
+ # create a closure for each word so that it matches stuff with spaces/punctuation
+ # and repeated characters in it
+ my $w = uc $_;
+ my @l = map { $_ eq 'I' ? '[I1]' : ($_ eq 'O' ? '[O0]' : $_) }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 $@;
+ }
+ }
+ $fh->close;
- my $l = "can't open $oldfn $!";
+ my $l = "can't open $regex $!";
dbg($l);
push @out, $l;
}
dbg($l);
push @out, $l;
}
sub check
{
my $s = uc shift;
sub check
{
my $s = uc shift;
+ my @out;
+
+ for (@regex) {
+ push @out, &$_($s);
+ }
+
+ return @out if @out;
for (split(/\s+/, $s)) {
s/[^\w]//g;
for (split(/\s+/, $s)) {
s/[^\w]//g;
- return $_ if $badword->in($_);
+ push @out, $_ if $badword->in($_);
- return $_ if $badword->in($_);
- }
-
- # look for a few of the common ones with spaces and stuff
- if ($s =~ /F[\s\W]*U[\s\W]*C[\s\W]*K/) {
- return "FUCK";
- } elsif ($s =~ /C[\s\W]*U[\s\W]*N[\s\W]*T/) {
- return "CUNT";
- } elsif ($s =~ /W[\s\W]*A[\s\W]*N[\s\W]*K/) {
- return "WANK";
- } elsif ($s =~ /C[\s\W]*[0O][\s\W]*C[\s\W]*K/) {
- return "COCK";
- } elsif ($s =~ /S[\s\W]*H[\s\W]*[I1][\s\W]*T/) {
- return "SHIT";
- } elsif ($s =~ /P[\s\W]*[I1][\s\W]*S[\s\W]*S/) {
- return "PISS";
- } elsif ($s =~ /B[\s\W]*[O0][\s\W]*L[\s\W]*L[\s\W]*[O0][\s\W]*[CK]/) {
- return "BOLLOCKS";
+ push @out, $_ if $badword->in($_);
use Date::Parse;
use IO::File;
use Date::Parse;
use IO::File;
use Data::Dumper;
use strict;
use Data::Dumper;
use strict;
@ISA = qw(Exporter);
@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf
parray parraypairs phex shellregex readfilestr writefilestr
@ISA = qw(Exporter);
@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf
parray parraypairs phex shellregex readfilestr writefilestr
print_all_fields cltounix unpad is_callsign is_latlong
is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
);
print_all_fields cltounix unpad is_callsign is_latlong
is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
);
+sub filecopy
+{
+ copy(@_) or return $!;
+}
+
# remove leading and trailing spaces from an input string
sub unpad
{
# remove leading and trailing spaces from an input string
sub unpad
{