From 4b062e291212f5c69167e3e9ac135f3cf3327199 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 18 Jan 2025 19:00:23 +0000 Subject: [PATCH] WIP on spot duplicates and things --- perl/AnnTalk.pm | 2 +- perl/DXDupe.pm | 25 ++++++++++++++----------- perl/DXProtHandle.pm | 32 +++++++++++++++++++------------- perl/DXXml.pm | 2 +- perl/Geomag.pm | 2 +- perl/Spot.pm | 12 ++++++------ perl/WCY.pm | 2 +- perl/cluster.pl | 2 +- perl/watchdbg | 1 + 9 files changed, 45 insertions(+), 35 deletions(-) diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index defc0110..e931d5a3 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -72,7 +72,7 @@ sub dup $text =~ s/[^\#a-zA-Z0-9]//g; $text = substr($text, 0, $duplth) if length $text > $duplth; my $dupkey = "A$call|$to|\L$text"; - return DXDupe::check($dupkey, $t); + return DXDupe::check_add($dupkey, $t); } sub listdups diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm index 795346db..c5b4b2a0 100644 --- a/perl/DXDupe.pm +++ b/perl/DXDupe.pm @@ -15,7 +15,7 @@ use DXVars; use vars qw{$lasttime $dbm %d $default $fn}; -$default = 48*24*60*60; +$default = 2*24*60*60; $lasttime = 0; localdata_mv("dupefile"); $fn = localdata("dupefile"); @@ -36,7 +36,8 @@ sub finish unlink $fn; } -sub check +# NOTE: This checks for a duplicate and only adds a new entry if not found +sub check_add { my $s = shift; return 1 if find($s); @@ -70,17 +71,14 @@ sub del delete $d{$s}; } -sub process +sub per_minute { - # once an hour - if ($main::systime - $lasttime >= 3600) { - my @del; - while (($k, $v) = each %d) { - push @del, $k if $main::systime >= $v; - } - del($k) for @del; - $lasttime = $main::systime; + my @del; + while (($k, $v) = each %d) { + push @del, $k if $main::systime >= $v; } + del($k) for @del; + $lasttime = $main::systime; } sub get @@ -99,9 +97,14 @@ sub listdups my $dupage = shift; my $regex = shift; + dbg("DXDupe::listdups let='$let' dupage='$dupage' input regex='$regex'") if isdbg('dxdupe'); + $regex =~ s/[\^\$\@\%]//g; $regex = ".*$regex" if $regex; $regex = "^$let" . $regex; + + dbg("DXDupe::listdups generated regex='$regex'") if isdbg('dxdupe'); + my @out; for (sort { $d{$a} <=> $d{$b} } grep { m{$regex}i } keys %d) { my ($dum, $key) = unpack "a1a*", $_; diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index ffe91741..868723fc 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -316,7 +316,6 @@ sub handle_11 return; } - # If we have an ip address we can promote by route if ($rug && $rug->ip) { $pcno = 61; @@ -347,17 +346,6 @@ sub handle_11 } } - # this goes after the input filtering, but before the add - # so that if it is input filtered, it isn't added to the dup - # list. This allows it to come in from a "legitimate" source - # - ## NOTE: this is where we insert the spot into the DXDupe cache - # - if (Spot::dup(@spot[0..4,7])) { - dbg("PCPROT: Duplicate Spot $self->{call}: $pc->[0] $key ignored\n") if isdbg('chanerr') || isdbg('dupespot') || isdbg('pc11'); - return; - } - dbg("PROCESSING $self->{call}: $pc->[0] key: $key") if isdbg('pc11'); if ($pcno == 11) { @@ -422,8 +410,26 @@ sub handle_11 } } + # this goes after the input filtering, but before the actual add + # of the spot so that if it is input filtered, it isn't added to the dup + # list. This allows it to come in from a "legitimate" source + # + ## NOTE: this is where we FINALLY insert the spot into the DXDupe cache + ## + ## Jan 2025 - I have moved this here so that ONLY potential spots for + ## output to users are added to the duplicate cache + # + # + + if (Spot::dup_add(0, @spot[0..4,7])) { + dbg("PCPROT: Duplicate Spot $self->{call}: $pc->[0] $key ignored\n") if isdbg('chanerr') || isdbg('dupespot') || isdbg('pc11'); + return; + } + + # + # Now finally: save the spot itself and send it on its merry way to the users + # - # add it Spot::add(@spot); my $ip = ''; diff --git a/perl/DXXml.pm b/perl/DXXml.pm index f05f3d1c..96aedcaa 100644 --- a/perl/DXXml.pm +++ b/perl/DXXml.pm @@ -123,7 +123,7 @@ sub normal # now check that we have not seen this before # this is based on the tuple (o (origin), t (time, normalised to time_t), id) $xref->{'-timet'} = $t; - return if DXDupe::check("xml,$o,$t,$id", $dupeage); + return if DXDupe::check_add("xml,$o,$t,$id", $dupeage); my $r = bless $xref, $pkg; $r->{'-xml'} = $line; diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 1a56305c..523e0dc0 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -289,7 +289,7 @@ sub dup return 2 if $d < $main::systime - $dupage; my $dupkey = "W$d|$sfi|$k|$a|$call"; - return DXDupe::check($dupkey, $main::systime+$dupage); + return DXDupe::check_add($dupkey, $main::systime+$dupage); } sub listdups diff --git a/perl/Spot.pm b/perl/Spot.pm index 0b622a1c..a63bcd10 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -476,10 +476,10 @@ sub formatl return "$s $comment$spotter"; } -# enter the spot for dup checking and return true if it is already a dup -sub dup +# Add the dupe if it is new. +sub dup_add { - my ($freq, $call, $d, $text, $by, $node, $just_find) = @_; + my ($just_find, $freq, $call, $d, $text, $by, $node) = @_; dbg("Spot::dup: freq=$freq call=$call d=$d text='$text' by=$by node=$node" . ($just_find ? " jf=$just_find" : "")) if isdbg('spotdup'); @@ -537,7 +537,7 @@ sub dup # new feature: don't include the origin node in Spot dupes # default = true $node = '' if $no_node_in_dupe; - $ldupkey = $oldstyle ? "X|$call|$by|$freq|$node|$d|$text" : "X|$call|$by|$qrg|$node|$nd|$text"; + $ldupkey = $oldstyle ? "X$call|$by|$freq|$node|$d|$text" : "X$call|$by|$qrg|$node|$nd|$text"; $t = DXDupe::find($ldupkey); dbg("Spot::dup ldupkey $ldupkey t '$t'" . ($t?' DUPE':' NEW')) if isdbg('spotdup'); @@ -550,7 +550,7 @@ sub dup $otext = substr($otext, 0, $duplth) if length $otext > $duplth; $otext =~ s/\s+$//; if (length $otext && $otext ne $text) { - $ldupkey = $oldstyle ? "X|$call|$by|$freq|$otext" : "X|$call|$by|$qrg|$otext"; + $ldupkey = $oldstyle ? "X$call|$by|$freq|$otext" : "X$call|$by|$qrg|$otext"; $t = DXDupe::find($ldupkey); dbg("Spot::dup (OTEXT) ldupkey $ldupkey t '$t'" . ($t?' DUPE':' NEW')) if isdbg('spotdup'); if (isdbg('spottext')) { @@ -566,7 +566,7 @@ sub dup sub dup_find { - return dup(@_, 1); + return dup_add(1, @_); } sub listdups diff --git a/perl/WCY.pm b/perl/WCY.pm index ef536ddb..1d46a8e2 100644 --- a/perl/WCY.pm +++ b/perl/WCY.pm @@ -263,7 +263,7 @@ sub dup return 2 if $d < $main::systime - $dupage; my $dupkey = "C$d"; - return DXDupe::check($dupkey, $main::systime+$dupage); + return DXDupe::check_add($dupkey, $main::systime+$dupage); } sub listdups diff --git a/perl/cluster.pl b/perl/cluster.pl index f7c85a6f..a4c831aa 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -871,7 +871,6 @@ sub per_sec DXMsg::process(); DXDb::process(); DXUser::process(); - DXDupe::process(); IsoTime::update($systime); DXConnect::process(); DXUser::process(); @@ -891,6 +890,7 @@ sub per_10_sec sub per_minute { RBN::per_minute(); + DXDupe::per_minute(); } sub per_10_minute diff --git a/perl/watchdbg b/perl/watchdbg index 2b1986a7..5fa7ebb2 100755 --- a/perl/watchdbg +++ b/perl/watchdbg @@ -54,6 +54,7 @@ while (@ARGV) { # seek to end of file $fh->seek(0, 2); for (;;) { + $fh->seek(0, 1); my $line = $fh->getline; if ($line) { if (@patt) { -- 2.43.0