From edc4edfd6dce0f2f76c03cb651bc49ba268ef03c Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 7 Jan 2022 09:40:07 +0000 Subject: [PATCH] merge in mojo Spot dedupe --- perl/DXProtHandle.pm | 9 ++++++--- perl/DXUtil.pm | 2 +- perl/Spot.pm | 14 ++++---------- 3 files changed, 11 insertions(+), 14 deletions(-) diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index 20aaf5a8..10518167 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -1568,8 +1568,12 @@ sub _decode_pc92_call $version =~ s/\D+//g; $build =~ s/^0\.//; $build =~ s/\D+//g; - $ip =~ s/,/:/g if $ip; - return ($call, $is_node, $is_extnode, $here, $version+0, $build+0, $ip); + if ($ip) { + $ip =~ s/,/:/g; + $ip =~ s/^::ffff://i; + } + dbg("$icall = '" . join("', '", $call, $is_node, $is_extnode, $here, $version, $build, $ip) . "'") if isdbg('pc92'); + return ($call, $is_node, $is_extnode, $here, $version, $build, $ip); } # decode a pc92 call: flag call : version : build @@ -1617,7 +1621,6 @@ sub _add_thingy my @rout; # remove spurious IPV6 prefix on IPV4 addresses - $ip =~ s/^::ffff:// if $ip; $build ||= 0; $version ||= 0; diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 51272d74..be6dfb4d 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -222,7 +222,7 @@ sub phash my $ref = shift; my $out; - while (my $k = sort keys %$ref) { + foreach my $k (sort keys %$ref) { $out .= "${k}=>$ref->{$k}, "; } $out =~ s/, $// if $out; diff --git a/perl/Spot.pm b/perl/Spot.pm index 8c353b90..862f9602 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -383,9 +383,8 @@ sub readfile($) } # enter the spot for dup checking and return true if it is already a dup -sub dup -{ - my ($freq, $call, $d, $text, $by, $cty) = @_; +sub dup { + my ($freq, $call, $d, $text, $by, $node) = @_; # dump if too old return 2 if $d < $main::systime - $dupage; @@ -404,21 +403,16 @@ sub dup chomp $text; $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; $text = uc unpad($text); - if ($cty && $text && length $text <= 4) { - unless ($text =~ /^C?Q/ || $text =~ /^[\d\W]+$/) { - my @try = Prefix::cty_data($text); - $text = "" if @try && $cty == $try[0]; - } - } my $otext = $text; # $text = Encode::encode("iso-8859-1", $text) if $main::can_encode && Encode::is_utf8($text, 1); $text =~ s/^\+\w+\s*//; # remove leading LoTW callsign $text =~ s/\s{2,}[\dA-Z]?[A-Z]\d?$// if length $text > 24; $text =~ s/[\W\x00-\x2F\x7B-\xFF]//g; # tautology, just to make quite sure! $text = substr($text, 0, $duplth) if length $text > $duplth; - my $ldupkey = "X$freq|$call|$by|$text"; + my $ldupkey = "X$|$call|$by|$node|$freq|$d|$text"; my $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; + DXDupe::add($ldupkey, $main::systime+$dupage); $otext = substr($otext, 0, $duplth) if length $otext > $duplth; $otext =~ s/\s+$//; -- 2.34.1