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 29408d1958ef13bdea61d48f0335c0682552fc2a..d57dc7306483a9c5723f1cb12eb346b0caca7f25 100644 (file)
--- 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 (file)
index 0000000..21a38a3
--- /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 (file)
index 0000000..eddefef
--- /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 (file)
index 0000000..76f0cf1
--- /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 b48dc7e0ca56f58a1bc8ed5693541cf89d6bbc93..0269edaa1e7a9ea4150fff83f9dccaf5efa65e5a 100644 (file)
--- 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 2336bb0468e22b1b95e3b517f5750c6397dd9fc2..e7d1169e3a390abd5845f5922bb299eaa79cefdc 100644 (file)
--- 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 6986a41aa60b1d8188dbc06d7ce4715a32eb35c1..a5aaa5cfebd1f122c1b68b274d166e3c613774bf 100644 (file)
--- 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 153618f9dc182f6a33bd1ee238130f121eef7bde..e986055692de4a2a00bca485b42a1d0c32b190bf 100644 (file)
--- 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;
                                                }
                                        }
                                }