X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=4c7ab06e3bd94b15b7f6be5afcc4a6f5085244f2;hb=211b54d504170a8c9dad2bf25b9ed686d5eeac11;hp=afc3410fb6e04045bdf7c774e766c6822a80f190;hpb=88665a2bed3b9ec9e97237938a95a045b2a21bb4;p=spider.git diff --git a/perl/Spot.pm b/perl/Spot.pm index afc3410f..4c7ab06e 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -15,18 +15,65 @@ use DXUtil; use DXLog; use Julian; use Prefix; +use DXDupe; use strict; -use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix %dup $duplth $dupage); +use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef); $fp = undef; $maxspots = 50; # maximum spots to return $defaultspots = 10; # normal number of spots to return $maxdays = 35; # normal maximum no of days to go back $dirprefix = "spots"; -%dup = (); # the spot duplicates hash $duplth = 20; # the length of text to use in the deduping $dupage = 3*3600; # the length of time to hold spot dups +$filterdef = bless ([ + # tag, sort, field, priv, special parser + ['freq', 'r', 0, 0, \&decodefreq], + ['call', 'c', 1], + ['info', 't', 3], + ['by', 'c', 4], + ['call_dxcc', 'n', 5], + ['by_dxcc', 'n', 6], + ['origin', 'c', 7, 9], + ['call_itu', 'n', 8], + ['call_zone', 'n', 9], + ['by_itu', 'n', 10], + ['by_zone', 'n', 11], + ['channel', 'n', 12, 9], + ], 'Filter::Cmd'); + + +sub decodefreq +{ + my $dxchan = shift; + my $l = shift; + my @f = split /,/, $l; + my @out; + my $f; + + foreach $f (@f) { + my ($a, $b); + if (m{^\d+/\d+$}) { + push @out, $f; + } elsif (($a, $b) = $f =~ m{^(\w+)(?:/(\w+))?$}) { + $b = lc $b if $b; + my @fr = Bands::get_freq(lc $a, $b); + if (@fr) { + while (@fr) { + $a = shift @fr; + $b = shift @fr; + push @out, "$a/$b"; # add them as ranges + } + } else { + return ('dfreq', $dxchan->msg('dfreq1', $f)); + } + } else { + return ('dfreq', $dxchan->msg('e20', $f)); + } + } + return (0, join(',', @out)); +} sub init { @@ -168,18 +215,21 @@ sub search # format a spot for user output in 'broadcast' mode sub formatb { - my @dx = @_; - my $t = ztime($dx[2]); - return sprintf "DX de %-7.7s%11.1f %-12.12s %-30s %s", "$dx[4]:", $dx[0], $dx[1], $dx[3], $t ; + my $wantgrid = shift; + my $t = ztime($_[2]); + my $ref = DXUser->get_current($_[4]); + my $loc = $ref->qra if $ref && $ref->qra && $wantgrid; + $loc = ' ' . substr($ref->qra, 0, 4) if $loc; + $loc = "" unless $loc; + return sprintf "DX de %-7.7s%11.1f %-12.12s %-30s %s$loc", "$_[4]:", $_[0], $_[1], $_[3], $t ; } # format a spot for user output in list mode sub formatl { - my @dx = @_; - my $t = ztime($dx[2]); - my $d = cldate($dx[2]); - return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ; + my $t = ztime($_[2]); + my $d = cldate($_[2]); + return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $_[0], $_[1], $d, $t, $_[3], "<$_[4]" ; } # @@ -209,32 +259,17 @@ sub dup return 2 if $d < $main::systime - $dupage; $freq = sprintf "%.1f", $freq; # normalise frequency - $d /= 60; # to the nearest minute chomp $text; $text = substr($text, 0, $duplth) if length $text > $duplth; - my $dupkey = "$freq|$call|$d|$text"; - return 1 if exists $dup{$dupkey}; - $dup{$dupkey} = $d * 60; # in seconds (to the nearest minute) - return 0; -} - -# called every hour and cleans out the dup cache -sub process -{ - my $cutoff = $main::systime - $dupage; - while (my ($key, $val) = each %dup) { - delete $dup{$key} if $val < $cutoff; - } + unpad($text); + $text =~ s/[^a-zA-Z0-9]//g; + my $dupkey = "X$freq|$call|$d|\L$text"; + return DXDupe::check($dupkey, $main::systime+$dupage); } sub listdups { - my @out; - for (sort { $dup{$a} <=> $dup{$b} } keys %dup) { - my $val = $dup{$_}; - push @out, "$_ = $val (" . cldatetime($val) . ")"; - } - return @out; + return DXDupe::listdups('X', $dupage, @_); } 1;