From: minima <minima>
Date: Thu, 13 Sep 2001 19:58:05 +0000 (+0000)
Subject: 5. Change the badwords interface to be the same as baddx, badspotter et al.
X-Git-Tag: R_1_48~23
X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=17f0b57add792391822d38116e89b33c1df4e2dd

5. Change the badwords interface to be the same as baddx, badspotter et al.
added set/badword, unset/badword and show/badword. This routine will auto
convert (and delete afterwards) the old badwords file.
Also make the ann->talk thingy less aggressive
---

diff --git a/Changes b/Changes
index 29408d19..d57dc730 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,9 @@ data (eg at init time with large lists of node/users on fast links).
 form 'to g1tlh hello', 't g1tlh hello'  or 'g1tlh hello' appear. 
 This also suppresses similar announces for users whose callsign is not the 
 one in the announce.
+5. Change the badwords interface to be the same as baddx, badspotter et al.
+added set/badword, unset/badword and show/badword. This routine will auto
+convert (and delete afterwards) the old badwords file. 
 11Sep01=======================================================================
 1. added IP address logging of connections
 10Sep01=======================================================================
diff --git a/cmd/set/badword.pl b/cmd/set/badword.pl
new file mode 100644
index 00000000..21a38a3c
--- /dev/null
+++ b/cmd/set/badword.pl
@@ -0,0 +1,10 @@
+#
+# set list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $BadWords::badword->set(8, $self->msg('e6'), $self, $line);
+
diff --git a/cmd/show/badword.pl b/cmd/show/badword.pl
new file mode 100644
index 00000000..eddefef8
--- /dev/null
+++ b/cmd/show/badword.pl
@@ -0,0 +1,10 @@
+#
+# show list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $BadWords::badword->show(1, $self);
+
diff --git a/cmd/unset/badword.pl b/cmd/unset/badword.pl
new file mode 100644
index 00000000..76f0cf10
--- /dev/null
+++ b/cmd/unset/badword.pl
@@ -0,0 +1,10 @@
+#
+# unset list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $BadWord::badwords->unset(8, $self->msg('e6'), $self, $line);
+
diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm
index b48dc7e0..0269edaa 100644
--- a/perl/AnnTalk.pm
+++ b/perl/AnnTalk.pm
@@ -62,6 +62,21 @@ sub listdups
 	return DXDupe::listdups('A', $dupage, @_);
 }
 
-
+# is this text field a likely announce to talk substitution?
+# this may involve all sorts of language dependant heuristics, but 
+# then again, it might not
+sub is_talk_candidate
+{
+	my ($from, $text) = @_;
+	my $call;
+	($call) = $text =~ /^\s*(?:[Xx]|[Tt][Oo]?)\s+([\w-]+)/;
+	($call) = $text =~ /^\s*>\s*([\w-]+)\b/ unless $call;
+	($call) = $text =~ /^\s*([\w-]+):?\b/ unless $call;
+	if ($call) {
+		$call = uc $call;
+		return is_callsign($call);
+	}
+    return undef;
+}
 1; 
 
diff --git a/perl/BadWords.pm b/perl/BadWords.pm
index 2336bb04..e7d1169e 100644
--- a/perl/BadWords.pm
+++ b/perl/BadWords.pm
@@ -12,12 +12,13 @@ use strict;
 
 use DXUtil;
 use DXVars;
+use DXHash;
 use IO::File;
 
-use vars qw(%badwords $fn);
+use vars qw($badword);
 
-$fn = "$main::data/badwords";
-%badwords = ();
+my $oldfn = "$main::data/badwords";
+$badword = new DXHash "badword";
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
@@ -29,23 +30,24 @@ $main::branch += $BRANCH;
 sub load
 {
 	my @out;
-	return unless -e $fn;
-	my $fh = new IO::File $fn;
+	return unless -e $oldfn;
+	my $fh = new IO::File $oldfn;
 	
 	if ($fh) {
-		%badwords = ();
 		while (<$fh>) {
 			chomp;
 			next if /^\s*\#/;
 			my @list = split " ";
 			for (@list) {
-				$badwords{lc $_}++;
+				$badword->add($_);
 			}
 		}
 		$fh->close;
+		$badword->put;
+		unlink $oldfn;
 	} else {
-		my $l = "can't open $fn $!";
-		dbg('err', $l);
+		my $l = "can't open $oldfn $!";
+		dbg($l);
 		push @out, $l;
 	}
 	return @out;
@@ -54,7 +56,7 @@ sub load
 # check the text against the badwords list
 sub check
 {
-	return grep { $badwords{$_} } split(/\b/, lc shift);
+	return grep { $badword->in($_) } split(/\b/, lc shift);
 }
 
 1;
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 6986a41a..a5aaa5cf 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -705,10 +705,10 @@ sub announce
 	my $text = shift;
 	my ($filter, $hops);
 
-	if ($suppress_ann_to_talk) {
-		my ($to, $call) = $text =~ /^\s*([\w-]+)[\s:]+([\w-]+)/;
-		return if ($to && $call && ((uc $to =~ /^TO?$/ && is_callsign(uc $call)) || is_callsign($call = uc $to)));
-	}	
+	if ($suppress_ann_to_talk && $to ne $self->{call}) {
+		my $call = AnnTalk::is_talk_candidate($_[0], $text);
+		return if $call && Route::get($call);
+	}
 
 	if ($self->{annfilter}) {
 		($filter, $hops) = $self->{annfilter}->it(@_ );
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 153618f9..e9860556 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -321,7 +321,8 @@ sub normal
 			}
 
 			# is it for me or one of mine?
-			my ($to, $via, $call, $dxchan);
+			my ($from, $to, $via, $call, $dxchan);
+			$from = $field[1];
 			if ($field[5] gt ' ') {
 				$via = $field[2];
 				$to = $field[5];
@@ -329,12 +330,20 @@ sub normal
 				$to = $field[2];
 			}
 
+			# if we are converting announces to talk is it a dup?
+			if ($ann_to_talk) {
+				if (AnnTalk::is_talk_candidate($$from, $field[3]) && AnnTalk::dup($$from, $to, $field[3])) {
+					dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr');
+					return;
+				}
+			}
+
 			# it is here and logged on
 			$dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
 			$dxchan = DXChannel->get($to) unless $dxchan;
 			if ($dxchan && $dxchan->is_user) {
 				$field[3] =~ s/\%5E/^/g;
-				$dxchan->talk($field[1], $to, $via, $field[3]);
+				$dxchan->talk($$from, $to, $via, $field[3]);
 				return;
 			}
 
@@ -345,17 +354,17 @@ sub normal
 			if ($ref = Route::get($to)) {
 				$vref = Route::Node::get($via) if $via;
 				$vref = undef unless $vref && grep $to eq $_, $vref->users;
-				$ref->dxchan->talk($field[1], $to, $vref ? $via : undef, $field[3], $field[6]);
+				$ref->dxchan->talk($$from, $to, $vref ? $via : undef, $field[3], $field[6]);
 				return;
 			}
 
 			# not visible here, send a message of condolence
 			$vref = undef;
-			$ref = Route::get($field[1]);
+			$ref = Route::get($$from);
 			$vref = $ref = Route::Node::get($field[6]) unless $ref; 
 			if ($ref) {
 				$dxchan = $ref->dxchan;
-				$dxchan->talk($main::mycall, $field[1], $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) );
+				$dxchan->talk($main::mycall, $$from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) );
 			}
 			return;
 		}
@@ -520,17 +529,13 @@ sub normal
 				# here's a bit of fun, convert incoming ann with a callsign in the first word
 				# or one saying 'to <call>' to a talk if we can route to the recipient
 				if ($ann_to_talk) {
-					my ($to, $call) = $field[3] =~ /^\s*([\w-]+)[\s:]+([\w-]+)/;
-					if ($to && $call) {
-						$to = uc $to;
-						$call = uc $call;
-						if (($to =~ /^TO?$/ && is_callsign($call)) || is_callsign($call = $to)) {
-							my $ref = Route::get($call);
-							if ($ref) {
-								my $dxchan = $ref->dxchan;
-								$dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self;
-								return;
-							}
+					my $call = AnnTalk::is_talk_candidate($field[1], $field[3]);
+					if ($call) {
+						my $ref = Route::get($call);
+						if ($ref) {
+							my $dxchan = $ref->dxchan;
+							$dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self;
+							return;
 						}
 					}
 				}