X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAnnTalk.pm;h=982e9c49afc9eb99b679ac180ecbdab8a48af0a4;hb=47597a3f8635c4d4de89419c0c808ddcda59b9d5;hp=911c2724ed021d3d03c15331bc8d6238fd362155;hpb=af0e6bdd59291e0fb872660f261ad720288068b5;p=spider.git diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index 911c2724..982e9c49 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -12,48 +12,54 @@ use strict; use DXUtil; use DXDebug; +use DXDupe; +use DXVars; -use vars qw(%dup $duplth $dupage); +use vars qw(%dup $duplth $dupage $filterdef); -%dup = (); # the duplicates hash $duplth = 60; # the length of text to use in the deduping -$dupage = 24*3600; # the length of time to hold spot dups +$dupage = 5*24*3600; # the length of time to hold spot dups +$filterdef = bless ([ + # tag, sort, field, priv, special parser + ['by', 'c', 0], + ['dest', 'c', 1], + ['info', 't', 2], + ['group', 't', 3], + ['origin', 'c', 4], + ['wx', 't', 5], + ['channel', 'n', 6], + ['by_dxcc', 'n', 7], + ['by_itu', 'n', 8], + ['by_zone', 'n', 9], + ['origin_dxcc', 'n', 10], + ['origin_itu', 'n', 11], + ['origin_itu', 'n', 12], + ], 'Filter::Cmd'); + +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$main::build += $VERSION; +$main::branch += $BRANCH; # enter the spot for dup checking and return true if it is already a dup sub dup { my ($call, $to, $text) = @_; - my $d = $main::systime; chomp $text; unpad($text); + $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; $text = substr($text, 0, $duplth) if length $text > $duplth; - my $dupkey = "$to|$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 = pack("C*", map {$_ & 127} unpack("C*", $text)); + $text =~ s/[^a-zA-Z0-9]//g; + my $dupkey = "A$to|\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('A', $dupage, @_); }