X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=7e621c91f4a947b4f7efa75e8c742916a9440c94;hb=b228776e730a2aaf6c18d2f88a458719e6b0275a;hp=1e7de69a7b32a5f9dbe8ab2651528143984fb801;hpb=261c75481017f32ca491df475b36e9600ca430a1;p=spider.git

diff --git a/perl/Spot.pm b/perl/Spot.pm
index 1e7de69a..7e621c91 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -15,18 +15,74 @@ 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
+$maxdays = 365;					# 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],
+			  ['on', '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');
+
+
+# create a Spot Object
+sub new
+{
+	my $class = shift;
+	my $self = [ @_ ];
+	return bless $self, $class;
+}
+
+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
 {
@@ -66,7 +122,7 @@ sub add
 	my $spotter_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0;
 	push @out, $spotter_dxcc;
 	push @out, $spot[5];
-	
+
 	my $buf = join("\^", @out);
 
 	# compare dates to see whether need to open another save file (remember, redefining $fp 
@@ -103,7 +159,7 @@ sub add
 
 sub search
 {
-	my ($expr, $dayfrom, $dayto, $from, $to) = @_;
+	my ($expr, $dayfrom, $dayto, $from, $to, $hint) = @_;
 	my $eval;
 	my @out;
 	my $ref;
@@ -119,6 +175,8 @@ sub search
 	@todate = Julian::sub(@fromdate, $dayto);
 	$from = 0 unless $from;
 	$to = $defaultspots unless $to;
+	$hint = $hint ? "next unless $hint" : "";
+	$expr = "1" unless $expr;
 	
 	$to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
 
@@ -129,6 +187,11 @@ sub search
   
 	# build up eval to execute
 	$eval = qq(
+			   while (<\$fh>) {
+				   $hint;
+				   chomp;
+				   push \@spots, [ split '\\^' ];
+			   }
 			   my \$c;
 			   my \$ref;
 			   for (\$c = \$#spots; \$c >= 0; \$c--) {
@@ -152,10 +215,6 @@ sub search
 		my $fh = $fp->open(@now); # get the next file
 		if ($fh) {
 			my $in;
-			while (<$fh>) {
-				chomp;
-				push @spots, [ split '\^' ];
-			}
 			eval $eval;			# do the search on this file
 			last if $count >= $to; # stop after to
 			return ("Spot search error", $@) if $@;
@@ -165,6 +224,32 @@ sub search
 	return @out;
 }
 
+# change a freq range->regular expression
+sub ftor
+{
+	my ($a, $b) = @_;
+	return undef unless $a < $b;
+	$b--;
+	my @a = split //, $a;
+	my @b = split //, $b;
+	my $out;
+	while (@b > @a) {
+		$out .= shift @b;
+	}
+	while (@b) {
+		my $aa = shift @a;
+		my $bb = shift @b;
+		if ($aa eq $bb) {
+			$out .= $aa;
+		} elsif ($aa < $bb) {
+			$out .= "[$aa-$bb]";
+		} else {
+			$out .= "[$bb-$aa]";
+		}
+	}
+	return $out;
+}
+
 # format a spot for user output in 'broadcast' mode
 sub formatb
 {
@@ -215,32 +300,15 @@ sub dup
 	chomp $text;
 	$text = substr($text, 0, $duplth) if length $text > $duplth; 
 	unpad($text);
-	my $dupkey = "$freq|$call|$d|$text";
-	return 1 if exists $dup{$dupkey};
-	$dup{$dupkey} = $d;         # 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;
-	}
+	$text =~ s/[\\\%]\d+//g;
+	$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 $regex = shift;
-	$regex = '.*' unless $regex;
-	$regex =~ s/[\$\@\%]//g;
-	my @out;
-	for (sort { $dup{$a} <=> $dup{$b} } grep { m{$regex}i } keys %dup) {
-		my $val = $dup{$_};
-		push @out, "$_ = " . cldatetime($val);
-	}
-	return @out;
+	return DXDupe::listdups('X', $dupage, @_);
 }
 1;