WIP spot deduping
authorDirk Koopman <djk@tobit.co.uk>
Sat, 20 Apr 2024 12:48:14 +0000 (13:48 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Sat, 20 Apr 2024 12:48:14 +0000 (13:48 +0100)
data/bands.pl
perl/DXDupe.pm
perl/Filter.pm
perl/Spot.pm

index 1bd60f671b6d0bc70268ad20ebcba7874df3038e..958c3bae6f3b10e1f053ba262ca9d55b83306a70 100644 (file)
 # It is up to YOU to make sure that it makes sense!
 #
 # ALL the labels MUST BE in lower case.
+#
+# Band names change (or I got them wrong in the first place), DO NOT CHANGE THE BAND NAMES
+# THAT I USED. If you do then expect to get complaints. Instead just alias then just alias
+# them to what you think they should be.
+#
+# WARNING: if aliasing, the band alias must be declared AFTER the original.
+#
+# See '550khz' and '630m' as an exemplar.
 # 
 
 
                  '136khz' => bless ( { band => [135, 138],
                                                          }, 'Bands'),
 
-                 '500khz' => bless ( { band => [493, 525],
+                 '500khz' => bless ( { band => [472, 479],
                                                          }, 'Bands'),
 
                  '160m' => bless( { band => [ 1800, 2000 ], 
-                                                        cw => [ 1800, 1838 ], 
+                                                        cw => [ 1800, 1840 ], 
                                                         rtty => [ 1838, 1841 ],
                                                         data => [ 1838, 1843],
                                                         ssb => [ 1831, 2000] 
@@ -34,7 +42,7 @@
 
                  '80m' => bless( { band => [ 3500, 4000 ], 
                                                        cw => [ 3500, 3600 ], 
-                                                       data => [ 3580, 3619 ], 
+                                                       data => [ 3570, 3619 ], 
                                                        rtty => [ 3580, 3619 ], 
                                                        sstv => [ 3730, 3740 ], 
                                                        ssb => [ 3601, 4000 ]  
                                                        ssb => [5300, 5410],
                                }, 'Bands' ),
 
-                 '40m' => bless( { band => [ 7000, 7400 ], 
+                 '40m' => bless( { band => [ 7000, 7300 ], 
                                                        cw => [ 7000, 7040 ],
                                                        data => [ 7040, 7100],
                                                        rtty => [ 7040, 7060],
-                                                       ssb => [ 7050, 7400 ]
+                                                       ssb => [ 7050, 7300 ]
                                                  }, 'Bands'),
 
                  '30m' => bless( { band => [ 10100, 10150 ], 
                                                        cw => [47087000, 47089000],
                                                        ssb => [47087000, 47089000],
                                                  }, 'Bands'),
+
                  '4mm' => bless( { band => [75500000, 81000000], 
                                                  }, 'Bands'), 
 
+                 '122g' => bless( { band => [122250000, 123000000], 
+                                                 }, 'Bands'), 
+
+                 '134g' => bless( { band => [134000000, 141000000],
+                                                  }, 'Bands'),
+
+                 '248g' => bless( { band => [241000000, 250000000], 
+                                                 }, 'Bands'), 
+
+                 
                  'band1' => bless ( { band => [47000, 49999, 52000, 68000],
                                                         }, 'Bands'),
                      
                   vhf => bless ( { band => [30000, 299999], }, 'Bands'), 
                 );
 
+#
+# fix up some aliases
+#
+
+$bands{'630m'} => $bands{'500khz'};
+$bands{'24g'} => $bands{'12mm'};
+$bands{'47g'} => $bands{'6mm'};
+$bands{'76g'} => $bands{'4mm'};
+
+
+
 #
 # the list of regions
 #
index 012039ee6a614eb8035b98fc27d3b6a87dd01a88..795346db5ad89ea1d104e20a61ebffead5aee7f1 100644 (file)
@@ -47,7 +47,7 @@ sub check
 sub find
 {
        return 0 unless $_[0];
-       return $d{$_[0]};
+       return exists $d{$_[0]} ? $d{$_[0]} : 0;
 }
 
 sub add
index f4089fcf9eeda8eefdb1a76838494274de721c4c..1c6b8589f93e803b8b9ca332d146737ce88709b2 100644 (file)
@@ -358,7 +358,8 @@ sub load_dxchan
 {
        my $dxchan = shift;
        my $sort = lc shift;
-       my $in = shift ? 'in' : '';
+       my $in = shift;
+       $in = $in ? 'in' : '';          # to cope with older perls that did not like a ternary expression with 'shift' as a conditional
        my $nossid = $dxchan->call;
        $nossid =~ s/-\d+$//;
        my $n = "$in$sort" . "filter";
index 64db9a722498109f10edcda7a5470ba2f05577b8..3012c9e968f4c36b958763b78baa15e6d511b4d5 100644 (file)
@@ -33,7 +33,7 @@ $maxspots = 100;                                      # maximum spots to return
 $defaultspots = 10;                            # normal number of spots to return
 $maxdays = 100;                                # normal maximum no of days to go back
 $dirprefix = "spots";
-$duplth = 20;                                  # the length of text to use in the deduping
+$duplth = 15;                                  # the length of text to use in the deduping
 $dupage = 1*3600;               # the length of time to hold spot dups
 $maxcalllth = 12;                               # the max length of call to take into account for dupes
 $filterdef = bless ([
@@ -502,29 +502,57 @@ sub dup
        
        $call = substr($call, 0, $maxcalllth) if length $call > $maxcalllth;
 
+       my $dtext ;
        
+       my $l = length $text;
+       $dtext = qq{original:'$text'($l)} if isdbg('spottext');
+
        chomp $text;
+       
        $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
        $text = uc unpad($text);
+
+       $l = length $text;
+       $dtext .= qq{->afterhex: '$text'($l)} if isdbg('spottext');
+       my @dubious;
+       if (isdbg('spottext')) {
+               (@dubious) = $text =~ /([?\x00-\x08\x0a-\x1F\x7B-\xFF]+)+/;
+               $dtext .= sprintf q{DUBIOUS '%s'}, join '', @dubious if @dubious;
+       }
+
        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/\s{2,}[\dA-Z]?[A-Z]\d?$//g if length $text > 24;
+       $text =~ s/\x09+//g;
        $text =~ s/[\W\x00-\x2F\x7B-\xFF]//g; # tautology, just to make quite sure!
-       $text = substr($text, 0, $duplth) if length $text > $duplth; 
+       $text = substr($text, 0, $duplth) if length $text > $duplth;
+
+       $l = length $text;
+       $dtext .= qq{->final:'$text'($l)} if isdbg('spottext');
+               
        my $ldupkey = $oldstyle ? "X|$call|$by|$node|$freq|$d|$text" : "X|$call|$by|$node|$qrg|$nd|$text";
 
-       my $t = DXDupe::find($ldupkey);
+       my $t = 0;
+       $t = DXDupe::find($ldupkey);
        dbg("Spot::dup ldupkey $ldupkey t '$t'") if isdbg('spotdup');
-       return 1 if $t > 0;
+       $dtext .= ' DUPE' if $t;
+       dbg("text transforms: $dtext") if length $text && isdbg('spottext');
+       return 1 if $t > 0;     
        
        DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+
        $otext = substr($otext, 0, $duplth) if length $otext > $duplth; 
        $otext =~ s/\s+$//;
        if (length $otext && $otext ne $text) {
                $ldupkey = $oldstyle ? "X|$freq|$call|$by|$otext" : "X|$qrg|$call|$by|$otext";
                $t = DXDupe::find($ldupkey);
-               dbg("Spot::dup ldupkey $ldupkey t '$t'") if isdbg('spotdup');
+               dbg("Spot::dup (OTEXT) ldupkey $ldupkey t '$t'") if isdbg('spotdup');
+               if (isdbg('spottext')) {
+                       $dtext .= sprintf q{DUBIOUS '%s'}, join '', @dubious if @dubious;
+                       $dtext .= ' DUPE (OTEXT)' if $t;
+                       dbg("text transforms: $dtext") if length $text;
+               }
                return 1 if $t > 0;
                DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
        }